<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-pragma">{-# LINE 1 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1"></span><span class="hs-pragma">{-# LANGUAGE BangPatterns #-}</span><span>
</span><span id="line-2"></span><span class="hs-pragma">{-# LANGUAGE DoAndIfThenElse #-}</span><span>
</span><span id="line-3"></span><span class="hs-pragma">{-# LANGUAGE ForeignFunctionInterface #-}</span><span>
</span><span id="line-4"></span><span class="hs-pragma">{-# LANGUAGE PatternGuards #-}</span><span>
</span><span id="line-5"></span><span class="hs-pragma">{-# LANGUAGE RecordWildCards #-}</span><span>
</span><span id="line-6"></span><span class="hs-pragma">{-# LANGUAGE NoImplicitPrelude #-}</span><span>
</span><span id="line-7"></span><span class="hs-pragma">{-# LANGUAGE CPP #-}</span><span>
</span><span id="line-8"></span><span class="hs-pragma">{-# LANGUAGE ScopedTypeVariables #-}</span><span>
</span><span id="line-9"></span><span>
</span><span id="line-10"></span><span class="hs-comment">-------------------------------------------------------------------------------</span><span>
</span><span id="line-11"></span><span class="hs-comment">-- |</span><span>
</span><span id="line-12"></span><span class="hs-comment">-- Module      :  GHC.Event.Windows</span><span>
</span><span id="line-13"></span><span class="hs-comment">-- Copyright   :  (c) Tamar Christina 2018</span><span>
</span><span id="line-14"></span><span class="hs-comment">-- License     :  BSD-style (see the file libraries/base/LICENSE)</span><span>
</span><span id="line-15"></span><span class="hs-comment">--</span><span>
</span><span id="line-16"></span><span class="hs-comment">-- Maintainer  :  libraries@haskell.org</span><span>
</span><span id="line-17"></span><span class="hs-comment">-- Stability   :  experimental</span><span>
</span><span id="line-18"></span><span class="hs-comment">-- Portability :  non-portable</span><span>
</span><span id="line-19"></span><span class="hs-comment">--</span><span>
</span><span id="line-20"></span><span class="hs-comment">-- WinIO Windows event manager.</span><span>
</span><span id="line-21"></span><span class="hs-comment">--</span><span>
</span><span id="line-22"></span><span class="hs-comment">-------------------------------------------------------------------------------</span><span>
</span><span id="line-23"></span><span>
</span><span id="line-24"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">GHC.Event.Windows</span><span> </span><span class="hs-special">(</span><span>
</span><span id="line-25"></span><span>    </span><span class="hs-comment">-- * Manager</span><span>
</span><span id="line-26"></span><span>    </span><span class="hs-identifier">Manager</span><span class="hs-special">,</span><span>
</span><span id="line-27"></span><span>    </span><span class="hs-identifier">getSystemManager</span><span class="hs-special">,</span><span>
</span><span id="line-28"></span><span>    </span><span class="hs-identifier">interruptSystemManager</span><span class="hs-special">,</span><span>
</span><span id="line-29"></span><span>    </span><span class="hs-identifier">wakeupIOManager</span><span class="hs-special">,</span><span>
</span><span id="line-30"></span><span>    </span><span class="hs-identifier">processRemoteCompletion</span><span class="hs-special">,</span><span>
</span><span id="line-31"></span><span>
</span><span id="line-32"></span><span>    </span><span class="hs-comment">-- * Overlapped I/O</span><span>
</span><span id="line-33"></span><span>    </span><span class="hs-identifier">associateHandle</span><span class="hs-special">,</span><span>
</span><span id="line-34"></span><span>    </span><span class="hs-identifier">associateHandle'</span><span class="hs-special">,</span><span>
</span><span id="line-35"></span><span>    </span><span class="hs-identifier">withOverlapped</span><span class="hs-special">,</span><span>
</span><span id="line-36"></span><span>    </span><span class="hs-identifier">withOverlappedEx</span><span class="hs-special">,</span><span>
</span><span id="line-37"></span><span>    </span><span class="hs-identifier">StartCallback</span><span class="hs-special">,</span><span>
</span><span id="line-38"></span><span>    </span><span class="hs-identifier">StartIOCallback</span><span class="hs-special">,</span><span>
</span><span id="line-39"></span><span>    </span><span class="hs-identifier">CbResult</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-40"></span><span>    </span><span class="hs-identifier">CompletionCallback</span><span class="hs-special">,</span><span>
</span><span id="line-41"></span><span>    </span><span class="hs-identifier">LPOVERLAPPED</span><span class="hs-special">,</span><span>
</span><span id="line-42"></span><span>
</span><span id="line-43"></span><span>    </span><span class="hs-comment">-- * Timeouts</span><span>
</span><span id="line-44"></span><span>    </span><span class="hs-identifier">TimeoutCallback</span><span class="hs-special">,</span><span>
</span><span id="line-45"></span><span>    </span><span class="hs-identifier">TimeoutKey</span><span class="hs-special">,</span><span>
</span><span id="line-46"></span><span>    </span><span class="hs-identifier">Seconds</span><span class="hs-special">,</span><span>
</span><span id="line-47"></span><span>    </span><span class="hs-identifier">registerTimeout</span><span class="hs-special">,</span><span>
</span><span id="line-48"></span><span>    </span><span class="hs-identifier">updateTimeout</span><span class="hs-special">,</span><span>
</span><span id="line-49"></span><span>    </span><span class="hs-identifier">unregisterTimeout</span><span class="hs-special">,</span><span>
</span><span id="line-50"></span><span>
</span><span id="line-51"></span><span>    </span><span class="hs-comment">-- * Utilities</span><span>
</span><span id="line-52"></span><span>    </span><span class="hs-identifier">withException</span><span class="hs-special">,</span><span>
</span><span id="line-53"></span><span>    </span><span class="hs-identifier">ioSuccess</span><span class="hs-special">,</span><span>
</span><span id="line-54"></span><span>    </span><span class="hs-identifier">ioFailed</span><span class="hs-special">,</span><span>
</span><span id="line-55"></span><span>    </span><span class="hs-identifier">ioFailedAny</span><span class="hs-special">,</span><span>
</span><span id="line-56"></span><span>    </span><span class="hs-identifier">getLastError</span><span class="hs-special">,</span><span>
</span><span id="line-57"></span><span>
</span><span id="line-58"></span><span>    </span><span class="hs-comment">-- * I/O Result type</span><span>
</span><span id="line-59"></span><span>    </span><span class="hs-identifier">IOResult</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-60"></span><span>
</span><span id="line-61"></span><span>    </span><span class="hs-comment">-- * I/O Event notifications</span><span>
</span><span id="line-62"></span><span>    </span><span class="hs-identifier">HandleData</span><span> </span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="hs-comment">-- seal for release</span><span>
</span><span id="line-63"></span><span>    </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">handleValue</span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-64"></span><span>    </span><span class="hs-identifier">registerHandle</span><span class="hs-special">,</span><span>
</span><span id="line-65"></span><span>    </span><span class="hs-identifier">unregisterHandle</span><span class="hs-special">,</span><span>
</span><span id="line-66"></span><span>
</span><span id="line-67"></span><span>    </span><span class="hs-comment">-- * Console events</span><span>
</span><span id="line-68"></span><span>    </span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">GHC.Event.Windows.ConsoleEvent</span><span>
</span><span id="line-69"></span><span class="hs-special">)</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-70"></span><span>
</span><span id="line-71"></span><span class="hs-comment">-- define DEBUG 1</span><span>
</span><span id="line-72"></span><span>
</span><span id="line-73"></span><span class="hs-comment">-- #define DEBUG_TRACE 1</span><span class="hs-cpp">

#include &quot;windows_cconv.h&quot;
</span><span>
</span><span id="line-77"></span><span>
</span><span id="line-78"></span><span>
</span><span id="line-79"></span><span>
</span><span id="line-80"></span><span>
</span><span id="line-81"></span><span class="hs-comment">-- There doesn't seem to be  GHC.* import for these</span><span>
</span><span id="line-82"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Control.Concurrent.MVar</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">modifyMVar</span><span class="hs-special">)</span><span>
</span><span id="line-83"></span><span class="hs-keyword">import</span><span> </span><span class="hs-pragma">{-# SOURCE</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-identifier">Control.Concurrent</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">forkOS</span><span class="hs-special">)</span><span>
</span><span id="line-84"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Data.Semigroup.Internal</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">stimesMonoid</span><span class="hs-special">)</span><span>
</span><span id="line-85"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Data.Foldable</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mapM_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">length</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">forM_</span><span class="hs-special">)</span><span>
</span><span id="line-86"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Data.Maybe</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">isJust</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">maybe</span><span class="hs-special">)</span><span>
</span><span id="line-87"></span><span>
</span><span id="line-88"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Windows.Clock</span><span>   </span><span class="hs-special">(</span><span class="hs-identifier">Clock</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">getClock</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">getTime</span><span class="hs-special">)</span><span>
</span><span id="line-89"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Windows.FFI</span><span>     </span><span class="hs-special">(</span><span class="hs-identifier">LPOVERLAPPED</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">OVERLAPPED_ENTRY</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span>
</span><span id="line-90"></span><span>                                  </span><span class="hs-identifier">CompletionData</span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">CompletionCallback</span><span class="hs-special">,</span><span>
</span><span id="line-91"></span><span>                                  </span><span class="hs-identifier">withRequest</span><span class="hs-special">)</span><span>
</span><span id="line-92"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Windows.ManagedThreadPool</span><span>
</span><span id="line-93"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Internal.Types</span><span>
</span><span id="line-94"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Unique</span><span>
</span><span id="line-95"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.TimeOut</span><span>
</span><span id="line-96"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Event.Windows.ConsoleEvent</span><span>
</span><span id="line-97"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Event.Windows.FFI</span><span>    </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">FFI</span><span>
</span><span id="line-98"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Event.PSQ</span><span>            </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">Q</span><span>
</span><span id="line-99"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Event.IntTable</span><span>       </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">IT</span><span>
</span><span id="line-100"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Event.Internal</span><span> </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">I</span><span>
</span><span id="line-101"></span><span>
</span><span id="line-102"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.MVar</span><span>
</span><span id="line-103"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Exception</span><span> </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">E</span><span>
</span><span id="line-104"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IORef</span><span>
</span><span id="line-105"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Maybe</span><span>
</span><span id="line-106"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Word</span><span>
</span><span id="line-107"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.OldList</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">deleteBy</span><span class="hs-special">)</span><span>
</span><span id="line-108"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Foreign</span><span>
</span><span id="line-109"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Event.Array</span><span>    </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">A</span><span>
</span><span id="line-110"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Base</span><span>
</span><span id="line-111"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Conc.Sync</span><span>
</span><span id="line-112"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IO</span><span>
</span><span id="line-113"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.IOPort</span><span>
</span><span id="line-114"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Num</span><span>
</span><span id="line-115"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Real</span><span>
</span><span id="line-116"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Enum</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">maxBound</span><span class="hs-special">)</span><span>
</span><span id="line-117"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.Windows</span><span>
</span><span id="line-118"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">GHC.List</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">null</span><span class="hs-special">)</span><span>
</span><span id="line-119"></span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">Text.Show</span><span>
</span><span id="line-120"></span><span>
</span><span id="line-121"></span><span>
</span><span id="line-122"></span><span class="hs-pragma">{-# LINE 126 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-126"></span><span>
</span><span id="line-127"></span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">qualified</span><span> </span><span class="hs-identifier">GHC.Windows</span><span> </span><span class="hs-keyword">as</span><span> </span><span class="hs-identifier">Win32</span><span>
</span><span id="line-128"></span><span>
</span><span id="line-129"></span><span>
</span><span id="line-130"></span><span class="hs-pragma">{-# LINE 132 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-132"></span><span>
</span><span id="line-133"></span><span class="hs-comment">-- Note [WINIO Manager design]</span><span>
</span><span id="line-134"></span><span class="hs-comment">-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~</span><span>
</span><span id="line-135"></span><span class="hs-comment">-- This file contains the Windows I//O manager. Windows's IO subsystem is by</span><span>
</span><span id="line-136"></span><span class="hs-comment">-- design fully asynchronous, however there are multiple ways and interfaces</span><span>
</span><span id="line-137"></span><span class="hs-comment">-- to the async methods.</span><span>
</span><span id="line-138"></span><span class="hs-comment">--</span><span>
</span><span id="line-139"></span><span class="hs-comment">-- The chosen Async interface for this implementation is using Completion Ports</span><span>
</span><span id="line-140"></span><span class="hs-comment">-- See also Note [Completion Ports]. The I/O manager uses a new interface added</span><span>
</span><span id="line-141"></span><span class="hs-comment">-- in Windows Vista called `GetQueuedCompletionStatusEx` which allows us to</span><span>
</span><span id="line-142"></span><span class="hs-comment">-- service multiple requests in one go.</span><span>
</span><span id="line-143"></span><span class="hs-comment">--</span><span>
</span><span id="line-144"></span><span class="hs-comment">-- See https://docs.microsoft.com/en-us/windows-hardware/drivers/kernel/overview-of-the-windows-i-o-model</span><span>
</span><span id="line-145"></span><span class="hs-comment">-- and https://www.microsoftpressstore.com/articles/article.aspx?p=2201309&amp;seqNum=3</span><span>
</span><span id="line-146"></span><span class="hs-comment">--</span><span>
</span><span id="line-147"></span><span class="hs-comment">-- In order to understand this file, here is what you should know:</span><span>
</span><span id="line-148"></span><span class="hs-comment">-- We're using relatively new APIs that allow us to service multiple requests at</span><span>
</span><span id="line-149"></span><span class="hs-comment">-- the same time using one OS thread.  This happens using so called Completion</span><span>
</span><span id="line-150"></span><span class="hs-comment">-- ports.  All I/O actions get associated with one and the same completion port.</span><span>
</span><span id="line-151"></span><span class="hs-comment">--</span><span>
</span><span id="line-152"></span><span class="hs-comment">-- The I/O manager itself has two mode of operation:</span><span>
</span><span id="line-153"></span><span class="hs-comment">-- 1) Threaded: We have N dedicated OS threads in the Haskell world that service</span><span>
</span><span id="line-154"></span><span class="hs-comment">--    completion requests. Everything is Handled 100% in view of the runtime.</span><span>
</span><span id="line-155"></span><span class="hs-comment">--    Whenever the OS has completions that need to be serviced it wakes up one</span><span>
</span><span id="line-156"></span><span class="hs-comment">--    one of the OS threads that are blocked in GetQueuedCompletionStatusEx and</span><span>
</span><span id="line-157"></span><span class="hs-comment">--    lets it proceed  with the list of completions that are finished. If more</span><span>
</span><span id="line-158"></span><span class="hs-comment">--    completions finish before the first list is done being processed then</span><span>
</span><span id="line-159"></span><span class="hs-comment">--    another thread is woken up.  These threads are associated with the I/O</span><span>
</span><span id="line-160"></span><span class="hs-comment">--    manager through the completion port.  If a thread blocks for any reason the</span><span>
</span><span id="line-161"></span><span class="hs-comment">--    OS I/O manager will wake up another thread blocked in GetQueuedCompletionStatusEx</span><span>
</span><span id="line-162"></span><span class="hs-comment">--    from the pool to finish processing the remaining entries.  This worker thread</span><span>
</span><span id="line-163"></span><span class="hs-comment">--    must be able to handle the</span><span>
</span><span id="line-164"></span><span class="hs-comment">--    fact that something else has finished the remainder of their queue or must</span><span>
</span><span id="line-165"></span><span class="hs-comment">--    have a guarantee to never block.  In this implementation we strive to</span><span>
</span><span id="line-166"></span><span class="hs-comment">--    never block.   This is achieved by not having the worker threads call out</span><span>
</span><span id="line-167"></span><span class="hs-comment">--    to any user code, and to have the IOPort synchronization primitive never</span><span>
</span><span id="line-168"></span><span class="hs-comment">--    block.   This means if the port is full the message is lost, however we</span><span>
</span><span id="line-169"></span><span class="hs-comment">--    have an invariant that the port can never be full and have a waiting</span><span>
</span><span id="line-170"></span><span class="hs-comment">--    receiver.  As such, dropping the message does not change anything as there</span><span>
</span><span id="line-171"></span><span class="hs-comment">--    will never be anyone to receive it. e.g. it is an impossible situation to</span><span>
</span><span id="line-172"></span><span class="hs-comment">--    land in.</span><span>
</span><span id="line-173"></span><span class="hs-comment">--    Note that it is valid (and perhaps expected) that at times two workers</span><span>
</span><span id="line-174"></span><span class="hs-comment">--    will receive the same requests to handle. We deal with this by using</span><span>
</span><span id="line-175"></span><span class="hs-comment">--    atomic operations to prevent race conditions. See processCompletion</span><span>
</span><span id="line-176"></span><span class="hs-comment">--    for details.</span><span>
</span><span id="line-177"></span><span class="hs-comment">-- 2) Non-threaded: We don't have any dedicated Haskell threads servicing</span><span>
</span><span id="line-178"></span><span class="hs-comment">--    I/O Requests. Instead we have an OS thread inside the RTS that gets</span><span>
</span><span id="line-179"></span><span class="hs-comment">--    notified of new requests and does the servicing.  When a request completes</span><span>
</span><span id="line-180"></span><span class="hs-comment">--    a Haskell thread is scheduled to run to finish off the processing of any</span><span>
</span><span id="line-181"></span><span class="hs-comment">--    completed requests. See Note [Non-Threaded WINIO design].</span><span>
</span><span id="line-182"></span><span class="hs-comment">--</span><span>
</span><span id="line-183"></span><span class="hs-comment">-- These two modes of operations share the majority of the code and so they both</span><span>
</span><span id="line-184"></span><span class="hs-comment">-- support the same operations and fixing one will fix the other.</span><span>
</span><span id="line-185"></span><span class="hs-comment">-- Unlike MIO, we don't threat network I/O any differently than file I/O. Hence</span><span>
</span><span id="line-186"></span><span class="hs-comment">-- any network specific code is now only in the network package.</span><span>
</span><span id="line-187"></span><span class="hs-comment">--</span><span>
</span><span id="line-188"></span><span class="hs-comment">-- See also Note [Completion Ports] which has some of the details which</span><span>
</span><span id="line-189"></span><span class="hs-comment">-- informed this design.</span><span>
</span><span id="line-190"></span><span class="hs-comment">--</span><span>
</span><span id="line-191"></span><span class="hs-comment">-- Note [Threaded WINIO design]</span><span>
</span><span id="line-192"></span><span class="hs-comment">-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~</span><span>
</span><span id="line-193"></span><span class="hs-comment">-- The threaded WiNIO is designed around a simple blocking call that's called in</span><span>
</span><span id="line-194"></span><span class="hs-comment">-- a service loop in a dedicated thread: `GetQueuedCompletionStatusEx`.</span><span>
</span><span id="line-195"></span><span class="hs-comment">-- as such the loop is reasonably simple.  We're either servicing finished</span><span>
</span><span id="line-196"></span><span class="hs-comment">-- requests or blocking in `getQueuedCompletionStatusEx` waiting for new</span><span>
</span><span id="line-197"></span><span class="hs-comment">-- requests to arrive.</span><span>
</span><span id="line-198"></span><span class="hs-comment">--</span><span>
</span><span id="line-199"></span><span class="hs-comment">-- Each time a Handle is made three important things happen that affect the I/O</span><span>
</span><span id="line-200"></span><span class="hs-comment">-- manager design:</span><span>
</span><span id="line-201"></span><span class="hs-comment">-- 1) Files are opened with the `FILE_FLAG_OVERLAPPED` flag, which instructs the</span><span>
</span><span id="line-202"></span><span class="hs-comment">--    OS that we will be doing purely asynchronous requests. See</span><span>
</span><span id="line-203"></span><span class="hs-comment">--    `GHC.IO.Windows.Handle.openFile`.  They are also opened with</span><span>
</span><span id="line-204"></span><span class="hs-comment">--    `FILE_FLAG_SEQUENTIAL_SCAN` to indicate to the OS that we want to optimize</span><span>
</span><span id="line-205"></span><span class="hs-comment">--    the access of the file for sequential access. (e.g. equivalent to MADVISE)</span><span>
</span><span id="line-206"></span><span class="hs-comment">-- 2) The created handle is associated with the I/O manager's completion port.</span><span>
</span><span id="line-207"></span><span class="hs-comment">--    This allows the I/O manager to be able to service I/O events from this</span><span>
</span><span id="line-208"></span><span class="hs-comment">--    handle.  See `associateHandle`.</span><span>
</span><span id="line-209"></span><span class="hs-comment">-- 3) File handles are additionally modified with two optimization flags:</span><span>
</span><span id="line-210"></span><span class="hs-comment">--</span><span>
</span><span id="line-211"></span><span class="hs-comment">--    FILE_SKIP_COMPLETION_PORT_ON_SUCCESS: If the request can be serviced</span><span>
</span><span id="line-212"></span><span class="hs-comment">--    immediately, then do not queue the IRP (IO Request Packet) into the I/O</span><span>
</span><span id="line-213"></span><span class="hs-comment">--    manager waiting for us to service it later.  Instead service it</span><span>
</span><span id="line-214"></span><span class="hs-comment">--    immediately in the same call.  This is beneficial for two reasons:</span><span>
</span><span id="line-215"></span><span class="hs-comment">--    1) We don't have to block in the Haskell RTS.</span><span>
</span><span id="line-216"></span><span class="hs-comment">--    2) We save a bunch of work in the OS's I/O subsystem.</span><span>
</span><span id="line-217"></span><span class="hs-comment">--    The downside is though that we have to do a bunch of work to handle these</span><span>
</span><span id="line-218"></span><span class="hs-comment">--    cases.  This is abstracted away from the user by the `withOverlapped`</span><span>
</span><span id="line-219"></span><span class="hs-comment">--    function.</span><span>
</span><span id="line-220"></span><span class="hs-comment">--    This together with the buffering strategy mentioned above means we</span><span>
</span><span id="line-221"></span><span class="hs-comment">--    actually skip the I/O manager on quite a lot of I/O requests due to the</span><span>
</span><span id="line-222"></span><span class="hs-comment">--    value being in the cache.  Because of the Lazy I/O in Haskell, the time</span><span>
</span><span id="line-223"></span><span class="hs-comment">--    to read and decode the buffer of bytes is usually longer than the OS needs</span><span>
</span><span id="line-224"></span><span class="hs-comment">--    to read the next chunk, so we hit the FAST_IO IRP quite often.</span><span>
</span><span id="line-225"></span><span class="hs-comment">--</span><span>
</span><span id="line-226"></span><span class="hs-comment">--    FILE_SKIP_SET_EVENT_ON_HANDLE: Since we will not be using an event object</span><span>
</span><span id="line-227"></span><span class="hs-comment">--    to monitor asynchronous completions, don't bother updating or checking for</span><span>
</span><span id="line-228"></span><span class="hs-comment">--    one.  This saves some precious cycles, especially on operations with very</span><span>
</span><span id="line-229"></span><span class="hs-comment">--    high number of I/O operations (e.g. servers.)</span><span>
</span><span id="line-230"></span><span class="hs-comment">--</span><span>
</span><span id="line-231"></span><span class="hs-comment">-- So what does servicing a request actually mean.  As mentioned before the</span><span>
</span><span id="line-232"></span><span class="hs-comment">-- I/O manager will be blocked or servicing a request. In reality it doesn't</span><span>
</span><span id="line-233"></span><span class="hs-comment">-- always block till an I/O request has completed.  In cases where we have event</span><span>
</span><span id="line-234"></span><span class="hs-comment">-- timers, we block till the next timer's timeout.  This allows us to also</span><span>
</span><span id="line-235"></span><span class="hs-comment">-- service timers in the same loop.  The side effect of this is that we will</span><span>
</span><span id="line-236"></span><span class="hs-comment">-- exit the I/O wait sometimes without any completions.  Not really a problem</span><span>
</span><span id="line-237"></span><span class="hs-comment">-- but it's an important design decision.</span><span>
</span><span id="line-238"></span><span class="hs-comment">--</span><span>
</span><span id="line-239"></span><span class="hs-comment">-- Every time we wait, we give a pre-allocated buffer of `n`</span><span>
</span><span id="line-240"></span><span class="hs-comment">-- `OVERLAPPED_ENTRIES` to the OS.  This means that in a single call we can</span><span>
</span><span id="line-241"></span><span class="hs-comment">-- service up to `n` I/O requests at a time.  The size of `n` is not fixed,</span><span>
</span><span id="line-242"></span><span class="hs-comment">-- anytime we dequeue `n` I/O requests in a single operation we double the</span><span>
</span><span id="line-243"></span><span class="hs-comment">-- buffer size, allowing the I/O manager to be able to scale up depending</span><span>
</span><span id="line-244"></span><span class="hs-comment">-- on the workload.  This buffer is kept alive throughout the lifetime of the</span><span>
</span><span id="line-245"></span><span class="hs-comment">-- program and is never freed until the I/O manager is shutting down.</span><span>
</span><span id="line-246"></span><span class="hs-comment">--</span><span>
</span><span id="line-247"></span><span class="hs-comment">-- One very important property of the I/O subsystem is that each I/O request</span><span>
</span><span id="line-248"></span><span class="hs-comment">-- now requires an `OVERLAPPED` structure be given to the I/O manager.  See</span><span>
</span><span id="line-249"></span><span class="hs-comment">-- `withOverlappedEx`.  This buffer is used by the OS to fill in various state</span><span>
</span><span id="line-250"></span><span class="hs-comment">-- information. Throughout the duration of I/O call, this buffer MUST</span><span>
</span><span id="line-251"></span><span class="hs-comment">-- remain live.  The address is pinned by the kernel, which means that the</span><span>
</span><span id="line-252"></span><span class="hs-comment">-- pointer must remain accessible until `GetQueuedCompletionStatusEx` returns</span><span>
</span><span id="line-253"></span><span class="hs-comment">-- the completion associated with the handle and not just until the call to what</span><span>
</span><span id="line-254"></span><span class="hs-comment">-- ever I/O operation was used to initialize the I/O request returns.</span><span>
</span><span id="line-255"></span><span class="hs-comment">-- The only exception to this is when the request has hit the FAST_IO path, in</span><span>
</span><span id="line-256"></span><span class="hs-comment">-- which case it has skipped the I/O queue and so can be freed immediately after</span><span>
</span><span id="line-257"></span><span class="hs-comment">-- reading the results from it.</span><span>
</span><span id="line-258"></span><span class="hs-comment">--</span><span>
</span><span id="line-259"></span><span class="hs-comment">-- To prevent having to lookup the Haskell payload in a shared state after the</span><span>
</span><span id="line-260"></span><span class="hs-comment">-- request completes we attach it as part of the I/O request by extending the</span><span>
</span><span id="line-261"></span><span class="hs-comment">-- `OVERLAPPED` structure.  Instead of passing an `OVERLAPPED` structure to the</span><span>
</span><span id="line-262"></span><span class="hs-comment">-- Windows API calls we instead pass a `HASKELL_OVERLAPPED` struct which has</span><span>
</span><span id="line-263"></span><span class="hs-comment">-- as the first element an `OVERLAPPED structure.  This means when a request is</span><span>
</span><span id="line-264"></span><span class="hs-comment">-- done all we need to do is cast the pointer back to `HASKELL_OVERLAPPED` and</span><span>
</span><span id="line-265"></span><span class="hs-comment">-- read the accompanying data.  This also means we don't have a global lock and</span><span>
</span><span id="line-266"></span><span class="hs-comment">-- so can scale much easier.</span><span>
</span><span id="line-267"></span><span class="hs-comment">--</span><span>
</span><span id="line-268"></span><span>
</span><span id="line-269"></span><span class="hs-comment">-- ---------------------------------------------------------------------------</span><span>
</span><span id="line-270"></span><span class="hs-comment">-- I/O manager global thread</span><span>
</span><span id="line-271"></span><span>
</span><span id="line-272"></span><span class="hs-comment">-- When running GHCi we still want to ensure we still only have one</span><span>
</span><span id="line-273"></span><span class="hs-comment">-- io manager thread, even if base is loaded twice. See the docs for</span><span>
</span><span id="line-274"></span><span class="hs-comment">-- sharedCAF for how this is done.</span><span>
</span><span id="line-275"></span><span>
</span><span id="line-276"></span><span class="hs-pragma">{-# NOINLINE</span><span> </span><span class="hs-pragma">ioManagerThread</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-277"></span><span class="hs-identifier">ioManagerThread</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">MVar</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">ThreadId</span><span class="hs-special">)</span><span>
</span><span id="line-278"></span><span class="hs-identifier">ioManagerThread</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">unsafePerformIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-279"></span><span>   </span><span class="hs-identifier">m</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newMVar</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-280"></span><span>   </span><span class="hs-identifier">sharedCAF</span><span> </span><span class="hs-identifier">m</span><span> </span><span class="hs-identifier">getOrSetGHCConcWindowsIOManagerThreadStore</span><span>
</span><span id="line-281"></span><span>
</span><span id="line-282"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;getOrSetGHCConcWindowsIOManagerThreadStore&quot;</span><span>
</span><span id="line-283"></span><span>  </span><span class="hs-identifier">getOrSetGHCConcWindowsIOManagerThreadStore</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-284"></span><span>
</span><span id="line-285"></span><span class="hs-comment">-- ---------------------------------------------------------------------------</span><span>
</span><span id="line-286"></span><span class="hs-comment">-- Non-threaded I/O manager callback hooks. See `ASyncWinIO.c`</span><span>
</span><span id="line-287"></span><span>
</span><span id="line-288"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">safe</span><span> </span><span class="hs-string">&quot;registerIOCPHandle&quot;</span><span>
</span><span id="line-289"></span><span>  </span><span class="hs-identifier">registerIOCPHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">FFI.IOCP</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-290"></span><span>
</span><span id="line-291"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">safe</span><span> </span><span class="hs-string">&quot;registerAlertableWait&quot;</span><span>
</span><span id="line-292"></span><span class="hs-comment">-- (bool has_timeout, DWORD mssec);</span><span>
</span><span id="line-293"></span><span>  </span><span class="hs-identifier">c_registerAlertableWait</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Bool</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">DWORD</span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-294"></span><span>
</span><span id="line-295"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">safe</span><span> </span><span class="hs-string">&quot;getOverlappedEntries&quot;</span><span>
</span><span id="line-296"></span><span>  </span><span class="hs-identifier">getOverlappedEntries</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">DWORD</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">OVERLAPPED_ENTRY</span><span class="hs-special">)</span><span>
</span><span id="line-297"></span><span>
</span><span id="line-298"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">safe</span><span> </span><span class="hs-string">&quot;completeSynchronousRequest&quot;</span><span>
</span><span id="line-299"></span><span>  </span><span class="hs-identifier">completeSynchronousRequest</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-300"></span><span>
</span><span id="line-301"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-302"></span><span class="hs-comment">-- Manager structures</span><span>
</span><span id="line-303"></span><span>
</span><span id="line-304"></span><span class="hs-comment">-- | Pointer offset in bytes to the location of hoData in HASKELL_OVERLAPPPED</span><span>
</span><span id="line-305"></span><span class="hs-identifier">cdOffset</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Int</span><span>
</span><span id="line-306"></span><span class="hs-identifier">cdOffset</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">32</span><span>
</span><span id="line-307"></span><span class="hs-pragma">{-# LINE 307 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-307"></span><span>
</span><span id="line-308"></span><span class="hs-comment">-- | Terminator symbol for IOCP request</span><span>
</span><span id="line-309"></span><span class="hs-identifier">nullReq</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CompletionData</span><span>
</span><span id="line-310"></span><span class="hs-identifier">nullReq</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">castPtr</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">unsafePerformIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">new</span><span> </span><span class="hs-special">(</span><span class="hs-number">0</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Int</span><span class="hs-special">)</span><span>
</span><span id="line-311"></span><span class="hs-pragma">{-# NOINLINE</span><span> </span><span class="hs-pragma">nullReq</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-312"></span><span>
</span><span id="line-313"></span><span class="hs-comment">-- I don't expect a lot of events, so a simple linked lists should be enough.</span><span>
</span><span id="line-314"></span><span class="hs-keyword">type</span><span> </span><span class="hs-identifier">EventElements</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">[</span><span class="hs-special">(</span><span class="hs-identifier">Event</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">HandleData</span><span class="hs-special">)</span><span class="hs-special">]</span><span>
</span><span id="line-315"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-identifier">evtTopLevel</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">Event</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">evtElems</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">EventElements</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-316"></span><span>
</span><span id="line-317"></span><span class="hs-keyword">instance</span><span> </span><span class="hs-identifier">Monoid</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-318"></span><span>  </span><span class="hs-identifier">mempty</span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-identifier">evtNothing</span><span> </span><span class="hs-special">[</span><span class="hs-special">]</span><span>
</span><span id="line-319"></span><span>  </span><span class="hs-identifier">mappend</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">(</span><span class="hs-operator">&lt;&gt;</span><span class="hs-special">)</span><span>
</span><span id="line-320"></span><span>
</span><span id="line-321"></span><span class="hs-keyword">instance</span><span> </span><span class="hs-identifier">Semigroup</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-322"></span><span>  </span><span class="hs-special">(</span><span class="hs-operator">&lt;&gt;</span><span class="hs-special">)</span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">a</span><span> </span><span class="hs-identifier">b</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">evtTopLevel</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-operator">&lt;&gt;</span><span> </span><span class="hs-identifier">evtTopLevel</span><span> </span><span class="hs-identifier">b</span><span class="hs-special">)</span><span>
</span><span id="line-323"></span><span>                             </span><span class="hs-special">(</span><span class="hs-identifier">evtElems</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">evtElems</span><span> </span><span class="hs-identifier">b</span><span class="hs-special">)</span><span>
</span><span id="line-324"></span><span>  </span><span class="hs-identifier">stimes</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">stimesMonoid</span><span>
</span><span id="line-325"></span><span>
</span><span id="line-326"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span>
</span><span id="line-327"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">IOSuccess</span><span> </span><span class="hs-special">{</span><span> </span><span class="hs-identifier">ioValue</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-328"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">IOFailed</span><span>  </span><span class="hs-special">{</span><span> </span><span class="hs-identifier">ioErrCode</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Int</span><span> </span><span class="hs-special">}</span><span>
</span><span id="line-329"></span><span>
</span><span id="line-330"></span><span class="hs-comment">-- | The state object for the I/O manager.  This structure is available for both</span><span>
</span><span id="line-331"></span><span class="hs-comment">-- the threaded and the non-threaded RTS.</span><span>
</span><span id="line-332"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">Manager</span><span>
</span><span id="line-333"></span><span>    </span><span class="hs-special">{</span><span> </span><span class="hs-identifier">mgrIOCP</span><span>         </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">FFI.IOCP</span><span>
</span><span id="line-334"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrClock</span><span>        </span><span class="hs-glyph">::</span><span>                </span><span class="hs-glyph">!</span><span class="hs-identifier">Clock</span><span>
</span><span id="line-335"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrUniqueSource</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">UniqueSource</span><span>
</span><span id="line-336"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrTimeouts</span><span>     </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-special">(</span><span class="hs-identifier">IORef</span><span> </span><span class="hs-identifier">TimeoutQueue</span><span class="hs-special">)</span><span>
</span><span id="line-337"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrEvntHandlers</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-338"></span><span>                         </span><span class="hs-glyph">!</span><span class="hs-special">(</span><span class="hs-identifier">MVar</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IT.IntTable</span><span> </span><span class="hs-identifier">EventData</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-339"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span>
</span><span id="line-340"></span><span>                      </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-#UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-special">(</span><span class="hs-identifier">A.Array</span><span> </span><span class="hs-identifier">OVERLAPPED_ENTRY</span><span class="hs-special">)</span><span>
</span><span id="line-341"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">mgrThreadPool</span><span>   </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">ThreadPool</span><span>
</span><span id="line-342"></span><span>    </span><span class="hs-special">}</span><span>
</span><span id="line-343"></span><span>
</span><span id="line-344"></span><span class="hs-pragma">{-# INLINE</span><span> </span><span class="hs-pragma">startIOManagerThread</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-345"></span><span class="hs-comment">-- | Starts a new I/O manager thread.</span><span>
</span><span id="line-346"></span><span class="hs-comment">-- For the threaded runtime it creates a pool of OS threads which stays alive</span><span>
</span><span id="line-347"></span><span class="hs-comment">-- until they are instructed to die.</span><span>
</span><span id="line-348"></span><span class="hs-comment">-- For the non-threaded runtime we have a single worker thread in</span><span>
</span><span id="line-349"></span><span class="hs-comment">-- the C runtime which we force to wake up instead.</span><span>
</span><span id="line-350"></span><span class="hs-comment">--</span><span>
</span><span id="line-351"></span><span class="hs-comment">-- TODO: Threadpools are not yet implemented.</span><span>
</span><span id="line-352"></span><span class="hs-identifier">startIOManagerThread</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-353"></span><span class="hs-identifier">startIOManagerThread</span><span> </span><span class="hs-identifier">loop</span><span>
</span><span id="line-354"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span>
</span><span id="line-355"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;startIOManagerThread:NonThreaded&quot;</span><span> </span><span class="hs-operator">&gt;&gt;</span><span>
</span><span id="line-356"></span><span>    </span><span class="hs-identifier">interruptSystemManager</span><span>
</span><span id="line-357"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-358"></span><span>    </span><span class="hs-identifier">modifyMVar_</span><span> </span><span class="hs-identifier">ioManagerThread</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">old</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-359"></span><span>      </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">create</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;spawning worker threads..&quot;</span><span>
</span><span id="line-360"></span><span>                      </span><span class="hs-identifier">t</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">forkOS</span><span> </span><span class="hs-identifier">loop</span><span>
</span><span id="line-361"></span><span>                      </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;created io-manager threads.&quot;</span><span>
</span><span id="line-362"></span><span>                      </span><span class="hs-identifier">labelThread</span><span> </span><span class="hs-identifier">t</span><span> </span><span class="hs-string">&quot;IOManagerThread&quot;</span><span>
</span><span id="line-363"></span><span>                      </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">t</span><span class="hs-special">)</span><span>
</span><span id="line-364"></span><span>      </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;startIOManagerThread old=&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">old</span><span>
</span><span id="line-365"></span><span>      </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">old</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-366"></span><span>        </span><span class="hs-identifier">Nothing</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">create</span><span>
</span><span id="line-367"></span><span>        </span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">t</span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-368"></span><span>          </span><span class="hs-identifier">s</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">threadStatus</span><span> </span><span class="hs-identifier">t</span><span>
</span><span id="line-369"></span><span>          </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-370"></span><span>            </span><span class="hs-identifier">ThreadFinished</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">create</span><span>
</span><span id="line-371"></span><span>            </span><span class="hs-identifier">ThreadDied</span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">create</span><span>
</span><span id="line-372"></span><span>            </span><span class="hs-identifier">_other</span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>  </span><span class="hs-identifier">interruptSystemManager</span><span>
</span><span id="line-373"></span><span>                                  </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">t</span><span class="hs-special">)</span><span>
</span><span id="line-374"></span><span>
</span><span id="line-375"></span><span class="hs-identifier">requests</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">MVar</span><span> </span><span class="hs-identifier">Word64</span><span>
</span><span id="line-376"></span><span class="hs-identifier">requests</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">unsafePerformIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">newMVar</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-377"></span><span>
</span><span id="line-378"></span><span class="hs-identifier">addRequest</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Word64</span><span>
</span><span id="line-379"></span><span class="hs-identifier">addRequest</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">modifyMVar</span><span> </span><span class="hs-identifier">requests</span><span> </span><span class="hs-special">(</span><span class="hs-glyph">\</span><span class="hs-identifier">x</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">x</span><span> </span><span class="hs-operator">+</span><span> </span><span class="hs-number">1</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">x</span><span> </span><span class="hs-operator">+</span><span> </span><span class="hs-number">1</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-380"></span><span>
</span><span id="line-381"></span><span class="hs-identifier">removeRequest</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Word64</span><span>
</span><span id="line-382"></span><span class="hs-identifier">removeRequest</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">modifyMVar</span><span> </span><span class="hs-identifier">requests</span><span> </span><span class="hs-special">(</span><span class="hs-glyph">\</span><span class="hs-identifier">x</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">x</span><span> </span><span class="hs-glyph">-</span><span> </span><span class="hs-number">1</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">x</span><span> </span><span class="hs-glyph">-</span><span> </span><span class="hs-number">1</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-383"></span><span>
</span><span id="line-384"></span><span class="hs-identifier">outstandingRequests</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Word64</span><span>
</span><span id="line-385"></span><span class="hs-identifier">outstandingRequests</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">withMVar</span><span> </span><span class="hs-identifier">requests</span><span> </span><span class="hs-identifier">return</span><span>
</span><span id="line-386"></span><span>
</span><span id="line-387"></span><span class="hs-identifier">getSystemManager</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Manager</span><span>
</span><span id="line-388"></span><span class="hs-identifier">getSystemManager</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">readMVar</span><span> </span><span class="hs-identifier">managerRef</span><span>
</span><span id="line-389"></span><span>
</span><span id="line-390"></span><span class="hs-comment">-- | Mutable reference to the IO manager</span><span>
</span><span id="line-391"></span><span class="hs-identifier">managerRef</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">MVar</span><span> </span><span class="hs-identifier">Manager</span><span>
</span><span id="line-392"></span><span class="hs-identifier">managerRef</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">unsafePerformIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">createManager</span><span> </span><span class="hs-operator">&gt;&gt;=</span><span> </span><span class="hs-identifier">newMVar</span><span>
</span><span id="line-393"></span><span>  </span><span class="hs-keyword">where</span><span>
</span><span id="line-394"></span><span>    </span><span class="hs-comment">-- | Create the I/O manager. In the Threaded I/O manager this call doesn't</span><span>
</span><span id="line-395"></span><span>    </span><span class="hs-comment">-- have any side effects, but in the Non-Threaded I/O manager the newly</span><span>
</span><span id="line-396"></span><span>    </span><span class="hs-comment">-- created IOCP handle will be registered with the RTS.  Users should never</span><span>
</span><span id="line-397"></span><span>    </span><span class="hs-comment">-- call this.</span><span>
</span><span id="line-398"></span><span>    </span><span class="hs-comment">-- It's only used to create the single global manager which is stored</span><span>
</span><span id="line-399"></span><span>    </span><span class="hs-comment">-- in an MVar.</span><span>
</span><span id="line-400"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-401"></span><span>    </span><span class="hs-comment">-- NOTE: This needs to finish without making any calls to anything requiring the</span><span>
</span><span id="line-402"></span><span>    </span><span class="hs-comment">-- I/O manager otherwise we'll get into some weird synchronization issues.</span><span>
</span><span id="line-403"></span><span>    </span><span class="hs-comment">-- Essentially this means avoid using long running operations here.</span><span>
</span><span id="line-404"></span><span>    </span><span class="hs-identifier">createManager</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Manager</span><span>
</span><span id="line-405"></span><span>    </span><span class="hs-identifier">createManager</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-406"></span><span>        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;Starting io-manager...&quot;</span><span>
</span><span id="line-407"></span><span>        </span><span class="hs-identifier">mgrIOCP</span><span>         </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.newIOCP</span><span>
</span><span id="line-408"></span><span>        </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-409"></span><span>          </span><span class="hs-identifier">registerIOCPHandle</span><span> </span><span class="hs-identifier">mgrIOCP</span><span>
</span><span id="line-410"></span><span>        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;iocp: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">mgrIOCP</span><span>
</span><span id="line-411"></span><span>        </span><span class="hs-identifier">mgrClock</span><span>             </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getClock</span><span>
</span><span id="line-412"></span><span>        </span><span class="hs-identifier">mgrUniqueSource</span><span>      </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newSource</span><span>
</span><span id="line-413"></span><span>        </span><span class="hs-identifier">mgrTimeouts</span><span>          </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newIORef</span><span> </span><span class="hs-identifier">Q.empty</span><span>
</span><span id="line-414"></span><span>        </span><span class="hs-identifier">mgrOverlappedEntries</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">A.new</span><span> </span><span class="hs-number">64</span><span>
</span><span id="line-415"></span><span>        </span><span class="hs-identifier">mgrEvntHandlers</span><span>      </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newMVar</span><span> </span><span class="hs-operator">=&lt;&lt;</span><span> </span><span class="hs-identifier">IT.new</span><span> </span><span class="hs-identifier">callbackArraySize</span><span>
</span><span id="line-416"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">mgrThreadPool</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-417"></span><span>
</span><span id="line-418"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">mgr</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span>
</span><span id="line-419"></span><span>        </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">mgr</span><span>
</span><span id="line-420"></span><span class="hs-pragma">{-# NOINLINE</span><span> </span><span class="hs-pragma">managerRef</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-421"></span><span>
</span><span id="line-422"></span><span class="hs-comment">-- | Interrupts an I/O manager Wait.  This will force the I/O manager to process</span><span>
</span><span id="line-423"></span><span class="hs-comment">-- any outstanding events and timers.  Also called when console events such as</span><span>
</span><span id="line-424"></span><span class="hs-comment">-- ctrl+c are used to break abort an I/O request.</span><span>
</span><span id="line-425"></span><span class="hs-identifier">interruptSystemManager</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-426"></span><span class="hs-identifier">interruptSystemManager</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-427"></span><span>  </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getSystemManager</span><span>
</span><span id="line-428"></span><span>  </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;interrupt received..&quot;</span><span>
</span><span id="line-429"></span><span>  </span><span class="hs-identifier">FFI.postQueuedCompletionStatus</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mgrIOCP</span><span> </span><span class="hs-identifier">mgr</span><span class="hs-special">)</span><span> </span><span class="hs-number">0</span><span> </span><span class="hs-number">0</span><span> </span><span class="hs-identifier">nullPtr</span><span>
</span><span id="line-430"></span><span>
</span><span id="line-431"></span><span class="hs-comment">-- | The initial number of I/O requests we can service at the same time.</span><span>
</span><span id="line-432"></span><span class="hs-comment">-- Must be power of 2.  This number is used as the starting point to scale</span><span>
</span><span id="line-433"></span><span class="hs-comment">-- the number of concurrent requests.  It will be doubled every time we are</span><span>
</span><span id="line-434"></span><span class="hs-comment">-- saturated.</span><span>
</span><span id="line-435"></span><span class="hs-identifier">callbackArraySize</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Int</span><span>
</span><span id="line-436"></span><span class="hs-identifier">callbackArraySize</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">32</span><span>
</span><span id="line-437"></span><span>
</span><span id="line-438"></span><span class="hs-comment">-----------------------------------------------------------------------</span><span>
</span><span id="line-439"></span><span class="hs-comment">-- Time utilities</span><span>
</span><span id="line-440"></span><span>
</span><span id="line-441"></span><span class="hs-identifier">secondsToNanoSeconds</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Q.Prio</span><span>
</span><span id="line-442"></span><span class="hs-identifier">secondsToNanoSeconds</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">ceiling</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000000000</span><span>
</span><span id="line-443"></span><span>
</span><span id="line-444"></span><span class="hs-identifier">secondsToMilliSeconds</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Word32</span><span>
</span><span id="line-445"></span><span class="hs-identifier">secondsToMilliSeconds</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">ceiling</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000</span><span>
</span><span id="line-446"></span><span>
</span><span id="line-447"></span><span class="hs-identifier">nanoSecondsToSeconds</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Q.Prio</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Seconds</span><span>
</span><span id="line-448"></span><span class="hs-identifier">nanoSecondsToSeconds</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-operator">/</span><span> </span><span class="hs-number">1000000000.0</span><span>
</span><span id="line-449"></span><span>
</span><span id="line-450"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-451"></span><span class="hs-comment">-- Overlapped I/O</span><span>
</span><span id="line-452"></span><span>
</span><span id="line-453"></span><span class="hs-comment">-- | Callback that starts the overlapped I/O operation.</span><span>
</span><span id="line-454"></span><span class="hs-comment">-- It must return successfully if and only if an I/O completion has been</span><span>
</span><span id="line-455"></span><span class="hs-comment">-- queued.  Otherwise, it must throw an exception, which 'withOverlapped'</span><span>
</span><span id="line-456"></span><span class="hs-comment">-- will rethrow.</span><span>
</span><span id="line-457"></span><span class="hs-keyword">type</span><span> </span><span class="hs-identifier">StartCallback</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">LPOVERLAPPED</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">a</span><span>
</span><span id="line-458"></span><span>
</span><span id="line-459"></span><span class="hs-comment">-- | Specialized callback type for I/O Completion Ports calls using</span><span>
</span><span id="line-460"></span><span class="hs-comment">-- withOverlapped.</span><span>
</span><span id="line-461"></span><span class="hs-keyword">type</span><span> </span><span class="hs-identifier">StartIOCallback</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">StartCallback</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">CbResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-462"></span><span>
</span><span id="line-463"></span><span class="hs-comment">-- | CallBack result type to disambiguate between the different states</span><span>
</span><span id="line-464"></span><span class="hs-comment">-- an I/O Completion call could be in.</span><span>
</span><span id="line-465"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">CbResult</span><span> </span><span class="hs-identifier">a</span><span>
</span><span id="line-466"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">DWORD</span><span class="hs-special">)</span><span> </span><span class="hs-comment">-- ^ Request was handled immediately, no queue.</span><span>
</span><span id="line-467"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">CbPending</span><span>            </span><span class="hs-comment">-- ^ Queued and to be handled by I/O manager</span><span>
</span><span id="line-468"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">CbIncomplete</span><span>         </span><span class="hs-comment">-- ^ I/O request is incomplete but not enqueued, handle</span><span>
</span><span id="line-469"></span><span>                         </span><span class="hs-comment">--   it synchronously.</span><span>
</span><span id="line-470"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">CbError</span><span> </span><span class="hs-identifier">a</span><span>            </span><span class="hs-comment">-- ^ I/O request abort, return failure immediately</span><span>
</span><span id="line-471"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">CbNone</span><span> </span><span class="hs-identifier">Bool</span><span>          </span><span class="hs-comment">-- ^ The caller did not do any checking, the I/O</span><span>
</span><span id="line-472"></span><span>                         </span><span class="hs-comment">--   manager will perform additional checks.</span><span>
</span><span id="line-473"></span><span>    </span><span class="hs-keyword">deriving</span><span> </span><span class="hs-identifier">Show</span><span>
</span><span id="line-474"></span><span>
</span><span id="line-475"></span><span class="hs-comment">-- | Associate a 'HANDLE' with the current I/O manager's completion port.</span><span>
</span><span id="line-476"></span><span class="hs-comment">-- This must be done before using the handle with 'withOverlapped'.</span><span>
</span><span id="line-477"></span><span class="hs-identifier">associateHandle'</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-478"></span><span class="hs-identifier">associateHandle'</span><span> </span><span class="hs-identifier">hwnd</span><span>
</span><span id="line-479"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getSystemManager</span><span>
</span><span id="line-480"></span><span>       </span><span class="hs-identifier">associateHandle</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-identifier">hwnd</span><span>
</span><span id="line-481"></span><span>
</span><span id="line-482"></span><span class="hs-comment">-- | A handle value representing an invalid handle.</span><span>
</span><span id="line-483"></span><span class="hs-identifier">invalidHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">HANDLE</span><span>
</span><span id="line-484"></span><span class="hs-identifier">invalidHandle</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">intPtrToPtr</span><span> </span><span class="hs-special">(</span><span class="hs-number">18446744073709551615</span><span class="hs-special">)</span><span>
</span><span id="line-485"></span><span class="hs-pragma">{-# LINE 485 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-485"></span><span>
</span><span id="line-486"></span><span class="hs-comment">-- | Associate a 'HANDLE' with the I/O manager's completion port.  This must be</span><span>
</span><span id="line-487"></span><span class="hs-comment">-- done before using the handle with 'withOverlapped'.</span><span>
</span><span id="line-488"></span><span class="hs-identifier">associateHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-489"></span><span class="hs-identifier">associateHandle</span><span> </span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-490"></span><span>    </span><span class="hs-comment">-- Don't try to if the handle is invalid.  This can happen with i.e a closed</span><span>
</span><span id="line-491"></span><span>    </span><span class="hs-comment">-- std handle.</span><span>
</span><span id="line-492"></span><span>    </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">h</span><span> </span><span class="hs-operator">/=</span><span> </span><span class="hs-identifier">invalidHandle</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-493"></span><span>      </span><span class="hs-comment">-- Use as completion key the file handle itself, so we can track</span><span>
</span><span id="line-494"></span><span>      </span><span class="hs-comment">-- completion</span><span>
</span><span id="line-495"></span><span>      </span><span class="hs-identifier">FFI.associateHandleWithIOCP</span><span> </span><span class="hs-identifier">mgrIOCP</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">ptrToWordPtr</span><span> </span><span class="hs-identifier">h</span><span class="hs-special">)</span><span>
</span><span id="line-496"></span><span>
</span><span id="line-497"></span><span>
</span><span id="line-498"></span><span class="hs-comment">{- Note [Why use non-waiting getOverlappedResult requests.]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  When waiting for a request that is bound to be done soon
  we spin inside waitForCompletion. There are multiple reasons
  for this.

  In the non-threaded RTS we can't perform blocking calls to
  C functions without blocking the whole RTS so immediately
  a blocking call is not an option there.

  In the threaded RTS we don't use a blocking wait for different
  reasons. In particular performing a waiting request using
  getOverlappedResult uses the hEvent object embedded in the
  OVERLAPPED structure to wait for a signal.
  However we do not provide such an object as their creation
  would incur to much overhead. Making a waiting request a
  less useful operation as it doesn't guarantee that the
  operation we were waiting one finished. Only that some
  operation on the handle did.

-}</span><span>
</span><span id="line-520"></span><span>
</span><span id="line-521"></span><span class="hs-comment">-- | Start an overlapped I/O operation, and wait for its completion.  If</span><span>
</span><span id="line-522"></span><span class="hs-comment">-- 'withOverlapped' is interrupted by an asynchronous exception, the operation</span><span>
</span><span id="line-523"></span><span class="hs-comment">-- will be canceled using @CancelIoEx@.</span><span>
</span><span id="line-524"></span><span class="hs-comment">--</span><span>
</span><span id="line-525"></span><span class="hs-comment">-- 'withOverlapped' waits for a completion to arrive before returning or</span><span>
</span><span id="line-526"></span><span class="hs-comment">-- throwing an exception.  This means you can use functions like</span><span>
</span><span id="line-527"></span><span class="hs-comment">-- 'Foreign.Marshal.Alloc.alloca' to allocate buffers for the operation.</span><span>
</span><span id="line-528"></span><span class="hs-identifier">withOverlappedEx</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-keyword">forall</span><span> </span><span class="hs-identifier">a</span><span class="hs-operator">.</span><span>
</span><span id="line-529"></span><span>                    </span><span class="hs-identifier">Manager</span><span>
</span><span id="line-530"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">String</span><span> </span><span class="hs-comment">-- ^ Handle name</span><span>
</span><span id="line-531"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-comment">-- ^ Windows handle associated with the operation.</span><span>
</span><span id="line-532"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Word64</span><span> </span><span class="hs-comment">-- ^ Value to use for the @OVERLAPPED@</span><span>
</span><span id="line-533"></span><span>                           </span><span class="hs-comment">--   structure's Offset/OffsetHigh members.</span><span>
</span><span id="line-534"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">StartIOCallback</span><span> </span><span class="hs-identifier">Int</span><span>
</span><span id="line-535"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CompletionCallback</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-536"></span><span>                 </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-537"></span><span class="hs-identifier">withOverlappedEx</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">fname</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">offset</span><span> </span><span class="hs-identifier">startCB</span><span> </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-538"></span><span>    </span><span class="hs-identifier">signal</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newEmptyIOPort</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOPort</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-539"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">signalReturn</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">failIfFalse_</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-string">&quot;signalReturn&quot;</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-540"></span><span>                            </span><span class="hs-identifier">writeIOPort</span><span> </span><span class="hs-identifier">signal</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOSuccess</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-541"></span><span>        </span><span class="hs-identifier">signalThrow</span><span> </span><span class="hs-identifier">ex</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">failIfFalse_</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-string">&quot;signalThrow&quot;</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-542"></span><span>                            </span><span class="hs-identifier">writeIOPort</span><span> </span><span class="hs-identifier">signal</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-identifier">ex</span><span class="hs-special">)</span><span>
</span><span id="line-543"></span><span>    </span><span class="hs-identifier">mask_</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-544"></span><span>      </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">completionCB'</span><span> </span><span class="hs-identifier">e</span><span> </span><span class="hs-identifier">b</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-identifier">e</span><span> </span><span class="hs-identifier">b</span><span> </span><span class="hs-operator">&gt;&gt;=</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">result</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-545"></span><span>                                </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">result</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-546"></span><span>                                  </span><span class="hs-identifier">IOSuccess</span><span> </span><span class="hs-identifier">val</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">signalReturn</span><span> </span><span class="hs-identifier">val</span><span>
</span><span id="line-547"></span><span>                                  </span><span class="hs-identifier">IOFailed</span><span>  </span><span class="hs-identifier">err</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">signalThrow</span><span> </span><span class="hs-identifier">err</span><span>
</span><span id="line-548"></span><span>      </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">callbackData</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">CompletionData</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">completionCB'</span><span>
</span><span id="line-549"></span><span>      </span><span class="hs-comment">-- Note [Memory Management]</span><span>
</span><span id="line-550"></span><span>      </span><span class="hs-comment">-- These callback data and especially the overlapped structs have to keep</span><span>
</span><span id="line-551"></span><span>      </span><span class="hs-comment">-- alive throughout the entire lifetime of the requests.   Since this</span><span>
</span><span id="line-552"></span><span>      </span><span class="hs-comment">-- function will block until done so it can call completionCB at the end</span><span>
</span><span id="line-553"></span><span>      </span><span class="hs-comment">-- we can safely use dynamic memory management here and so reduce the</span><span>
</span><span id="line-554"></span><span>      </span><span class="hs-comment">-- possibility of memory errors.</span><span>
</span><span id="line-555"></span><span>      </span><span class="hs-identifier">withRequest</span><span> </span><span class="hs-identifier">offset</span><span> </span><span class="hs-identifier">callbackData</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">hs_lpol</span><span> </span><span class="hs-identifier">cdData</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-556"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">hs_lpol</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">plusPtr</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">cdOffset</span><span>
</span><span id="line-557"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">castPtr</span><span> </span><span class="hs-identifier">hs_lpol</span><span>
</span><span id="line-558"></span><span>        </span><span class="hs-comment">-- We need to add the payload before calling startCBResult, the reason being</span><span>
</span><span id="line-559"></span><span>        </span><span class="hs-comment">-- that the I/O routine begins immediately then.  If we don't then the request</span><span>
</span><span id="line-560"></span><span>        </span><span class="hs-comment">-- may end up lost as processCompletion will get called with a null payload.</span><span>
</span><span id="line-561"></span><span>        </span><span class="hs-identifier">poke</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-identifier">cdData</span><span>
</span><span id="line-562"></span><span>
</span><span id="line-563"></span><span>        </span><span class="hs-comment">-- Since FILE_SKIP_COMPLETION_PORT_ON_SUCCESS can't be</span><span>
</span><span id="line-564"></span><span>        </span><span class="hs-comment">-- relied on for non-file handles we need a way to prevent</span><span>
</span><span id="line-565"></span><span>        </span><span class="hs-comment">-- us from handling a request inline and handle a completion</span><span>
</span><span id="line-566"></span><span>        </span><span class="hs-comment">-- event handled without a queued I/O operation.  Which means we</span><span>
</span><span id="line-567"></span><span>        </span><span class="hs-comment">-- can't solely rely on the number of oustanding requests but most</span><span>
</span><span id="line-568"></span><span>        </span><span class="hs-comment">-- also check intermediate status.</span><span>
</span><span id="line-569"></span><span>        </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">addRequest</span><span>
</span><span id="line-570"></span><span>        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;+1.. &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; requests queued. | &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-571"></span><span>        </span><span class="hs-identifier">cdDataCheck</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CompletionData</span><span class="hs-special">)</span><span>
</span><span id="line-572"></span><span>        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;hs_lpol:&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">hs_lpol</span><span>
</span><span id="line-573"></span><span>                </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; cdData:&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">cdData</span><span>
</span><span id="line-574"></span><span>                </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; ptr_lpol:&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">ptr_lpol</span><span>
</span><span id="line-575"></span><span>                </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; *ptr_lpol:&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">cdDataCheck</span><span>
</span><span id="line-576"></span><span>
</span><span id="line-577"></span><span>        </span><span class="hs-identifier">startCBResult</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">startCB</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">onException</span><span class="hs-special">`</span><span>
</span><span id="line-578"></span><span>                        </span><span class="hs-special">(</span><span class="hs-identifier">CbError</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">fmap</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">Win32.getLastError</span><span class="hs-special">)</span><span> </span><span class="hs-operator">&gt;&gt;=</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">result</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-579"></span><span>          </span><span class="hs-comment">-- Check to see if the operation was completed on a</span><span>
</span><span id="line-580"></span><span>          </span><span class="hs-comment">-- non-overlapping handle or was completed immediately.</span><span>
</span><span id="line-581"></span><span>          </span><span class="hs-comment">-- e.g. stdio redirection or data in cache, FAST I/O.</span><span>
</span><span id="line-582"></span><span>          </span><span class="hs-identifier">success</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIOStatus</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-583"></span><span>          </span><span class="hs-identifier">err</span><span>     </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getLastError</span><span>
</span><span id="line-584"></span><span>          </span><span class="hs-comment">-- Determine if the caller has done any checking.  If not then check</span><span>
</span><span id="line-585"></span><span>          </span><span class="hs-comment">-- to see if the request was completed synchronously.  We have to</span><span>
</span><span id="line-586"></span><span>          </span><span class="hs-comment">-- in order to prevent deadlocks since if it has completed</span><span>
</span><span id="line-587"></span><span>          </span><span class="hs-comment">-- synchronously we've requested to not have the completion queued.</span><span>
</span><span id="line-588"></span><span>          </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">result'</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-589"></span><span>                </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">result</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-590"></span><span>                  </span><span class="hs-identifier">CbNone</span><span> </span><span class="hs-identifier">ret</span><span> </span><span class="hs-comment">-- Start by checking some flags which indicates we</span><span>
</span><span id="line-591"></span><span>                             </span><span class="hs-comment">-- are done.</span><span>
</span><span id="line-592"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">success</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">0</span><span>          </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-593"></span><span class="hs-pragma">{-# LINE 593 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-593"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">success</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-glyph">-</span><span class="hs-number">1073741807</span><span>      </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-594"></span><span class="hs-pragma">{-# LINE 594 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-594"></span><span>                             </span><span class="hs-comment">-- Buffer was too small.. not sure what to do, so I'll just</span><span>
</span><span id="line-595"></span><span>                             </span><span class="hs-comment">-- complete the read request</span><span>
</span><span id="line-596"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">234</span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-597"></span><span class="hs-pragma">{-# LINE 597 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-597"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">0</span><span>           </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-598"></span><span class="hs-pragma">{-# LINE 598 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-598"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">997</span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbPending</span><span>
</span><span id="line-599"></span><span class="hs-pragma">{-# LINE 599 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-599"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">996</span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbIncomplete</span><span>
</span><span id="line-600"></span><span class="hs-pragma">{-# LINE 600 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-600"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">38</span><span>        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-601"></span><span class="hs-pragma">{-# LINE 601 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-601"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">109</span><span>       </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-602"></span><span class="hs-pragma">{-# LINE 602 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-602"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">259</span><span>     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-603"></span><span class="hs-pragma">{-# LINE 603 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-603"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">err</span><span>     </span><span class="hs-operator">==</span><span> </span><span class="hs-number">995</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-604"></span><span class="hs-pragma">{-# LINE 604 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-604"></span><span>                             </span><span class="hs-comment">-- This is currently mapping all non-complete requests we don't know</span><span>
</span><span id="line-605"></span><span>                             </span><span class="hs-comment">-- about as an error. I wonder if this isn't too strict..</span><span>
</span><span id="line-606"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">ret</span><span>                                     </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbError</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">err</span><span>
</span><span id="line-607"></span><span>                             </span><span class="hs-comment">-- We check success codes after checking error as</span><span>
</span><span id="line-608"></span><span>                             </span><span class="hs-comment">-- errors are much more indicative</span><span>
</span><span id="line-609"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">success</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">259</span><span>          </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbPending</span><span>
</span><span id="line-610"></span><span class="hs-pragma">{-# LINE 610 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-610"></span><span>                             </span><span class="hs-comment">-- If not just assume we can complete.  If we can't this will</span><span>
</span><span id="line-611"></span><span>                             </span><span class="hs-comment">-- hang because we don't know how to properly deal with it.</span><span>
</span><span id="line-612"></span><span>                             </span><span class="hs-comment">-- I don't know what the best default here is...</span><span>
</span><span id="line-613"></span><span>                             </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span>                                   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CbPending</span><span>
</span><span id="line-614"></span><span>                  </span><span class="hs-identifier">_</span><span>                                                        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">result</span><span>
</span><span id="line-615"></span><span>          </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">result'</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-616"></span><span>            </span><span class="hs-identifier">CbNone</span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">error</span><span> </span><span class="hs-string">&quot;withOverlappedEx: CbNone shouldn't happen.&quot;</span><span>
</span><span id="line-617"></span><span>            </span><span class="hs-identifier">CbIncomplete</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-618"></span><span>               </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;handling incomplete request synchronously &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">h</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">lpol</span><span class="hs-special">)</span><span>
</span><span id="line-619"></span><span>               </span><span class="hs-identifier">res</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">waitForCompletion</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-620"></span><span>               </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;done blocking request 2: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">h</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">lpol</span><span class="hs-special">)</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; - &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-621"></span><span>               </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-622"></span><span>            </span><span class="hs-identifier">CbPending</span><span>   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-623"></span><span>              </span><span class="hs-comment">-- Before we enqueue check see if operation finished in the</span><span>
</span><span id="line-624"></span><span>              </span><span class="hs-comment">-- mean time, since caller may not have done this.</span><span>
</span><span id="line-625"></span><span>              </span><span class="hs-comment">-- Normally we'd have to clear lpol with 0 before this call,</span><span>
</span><span id="line-626"></span><span>              </span><span class="hs-comment">-- however the statuses we're interested in would not get to here</span><span>
</span><span id="line-627"></span><span>              </span><span class="hs-comment">-- so we can save the memset call.</span><span>
</span><span id="line-628"></span><span>              </span><span class="hs-identifier">finished</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.getOverlappedResult</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-629"></span><span>              </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;== &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">finished</span><span class="hs-special">)</span><span>
</span><span id="line-630"></span><span>              </span><span class="hs-identifier">status</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIOStatus</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-631"></span><span>              </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;== &gt;&lt; &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">status</span><span class="hs-special">)</span><span>
</span><span id="line-632"></span><span>              </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getLastError</span><span>
</span><span id="line-633"></span><span>              </span><span class="hs-comment">-- This status indicated that we have finished early and so we</span><span>
</span><span id="line-634"></span><span>              </span><span class="hs-comment">-- won't have a request enqueued.  Handle it inline.</span><span>
</span><span id="line-635"></span><span>              </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">done_early</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">status</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-636"></span><span class="hs-pragma">{-# LINE 636 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-636"></span><span>                               </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">status</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-glyph">-</span><span class="hs-number">1073741807</span><span>
</span><span id="line-637"></span><span class="hs-pragma">{-# LINE 637 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-637"></span><span>                               </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">errorIsCompleted</span><span> </span><span class="hs-identifier">lasterr</span><span>
</span><span id="line-638"></span><span>              </span><span class="hs-comment">-- This status indicates that the request hasn't finished early,</span><span>
</span><span id="line-639"></span><span>              </span><span class="hs-comment">-- but it will finish shortly.  The I/O manager will not be</span><span>
</span><span id="line-640"></span><span>              </span><span class="hs-comment">-- enqueuing this either.  Also needs to be handled inline.</span><span>
</span><span id="line-641"></span><span>              </span><span class="hs-comment">-- Sadly named pipes will always return this error, so in practice</span><span>
</span><span id="line-642"></span><span>              </span><span class="hs-comment">-- we end up always handling them synchronously. There is no good</span><span>
</span><span id="line-643"></span><span>              </span><span class="hs-comment">-- documentation on this.</span><span>
</span><span id="line-644"></span><span>              </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">will_finish_sync</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">996</span><span>
</span><span id="line-645"></span><span class="hs-pragma">{-# LINE 645 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-645"></span><span>
</span><span id="line-646"></span><span>              </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;== &gt;*&lt; &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">finished</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">done_early</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">will_finish_sync</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">h</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">lpol</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">lasterr</span><span class="hs-special">)</span><span>
</span><span id="line-647"></span><span>              </span><span class="hs-keyword">case</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">finished</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">done_early</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">will_finish_sync</span><span class="hs-special">)</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-648"></span><span>                </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">_</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-649"></span><span>                  </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;request handled immediately (o/b), not queued.&quot;</span><span>
</span><span id="line-650"></span><span>                  </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">finished</span><span>
</span><span id="line-651"></span><span>                </span><span class="hs-comment">-- Still pending</span><span>
</span><span id="line-652"></span><span>                </span><span class="hs-special">(</span><span class="hs-identifier">Nothing</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">_</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-653"></span><span>                    </span><span class="hs-comment">-- If we should add back support to suspend the IO Manager thread</span><span>
</span><span id="line-654"></span><span>                    </span><span class="hs-comment">-- then we will need to make sure it's running at this point.</span><span>
</span><span id="line-655"></span><span>                    </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">result'</span><span>
</span><span id="line-656"></span><span>            </span><span class="hs-identifier">CbError</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">signalThrow</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">err'</span><span class="hs-special">)</span><span> </span><span class="hs-operator">&gt;&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">result'</span><span>
</span><span id="line-657"></span><span>            </span><span class="hs-identifier">CbDone</span><span>  </span><span class="hs-identifier">_</span><span>   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-658"></span><span>              </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;request handled immediately (o), not queued.&quot;</span><span> </span><span class="hs-operator">&gt;&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">result'</span><span>
</span><span id="line-659"></span><span>
</span><span id="line-660"></span><span>        </span><span class="hs-comment">-- If an exception was received while waiting for IO to complete</span><span>
</span><span id="line-661"></span><span>        </span><span class="hs-comment">-- we try to cancel the request here.</span><span>
</span><span id="line-662"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">cancel</span><span> </span><span class="hs-identifier">e</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-663"></span><span>                        </span><span class="hs-identifier">nerr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getLastError</span><span>
</span><span id="line-664"></span><span>                        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;## Exception occurred. Cancelling request... &quot;</span><span>
</span><span id="line-665"></span><span>                        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">e</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">SomeException</span><span class="hs-special">)</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; : &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">nerr</span><span>
</span><span id="line-666"></span><span>                        </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">uninterruptibleMask_</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">FFI.cancelIoEx'</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-667"></span><span>                        </span><span class="hs-comment">-- we need to wait for the cancellation before removing</span><span>
</span><span id="line-668"></span><span>                        </span><span class="hs-comment">-- the pointer.</span><span>
</span><span id="line-669"></span><span>                        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;## Waiting for cancellation record... &quot;</span><span>
</span><span id="line-670"></span><span>                        </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.getOverlappedResult</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-671"></span><span>                        </span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">I.exchangePtr</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-identifier">nullReq</span><span>
</span><span id="line-672"></span><span>                        </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">cdData</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-673"></span><span>                          </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">reqs1</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">removeRequest</span><span>
</span><span id="line-674"></span><span>                             </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;-1.. &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs1</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; requests queued after error.&quot;</span><span>
</span><span id="line-675"></span><span>                             </span><span class="hs-identifier">completionCB'</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">nerr</span><span class="hs-special">)</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-676"></span><span>                        </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-677"></span><span>                          </span><span class="hs-keyword">do</span><span> </span><span class="hs-comment">-- Run timeouts. This way if we canceled the last</span><span>
</span><span id="line-678"></span><span>                             </span><span class="hs-comment">-- IO Request and have no timer events waiting we</span><span>
</span><span id="line-679"></span><span>                             </span><span class="hs-comment">-- can go into an unbounded alertable wait.</span><span>
</span><span id="line-680"></span><span>                             </span><span class="hs-identifier">delay</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">runExpiredTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span>
</span><span id="line-681"></span><span>                             </span><span class="hs-identifier">registerAlertableWait</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-682"></span><span>                        </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-683"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">runner</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-string">&quot;:: waiting &quot;</span><span class="hs-special">)</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; | &quot;</span><span>  </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-684"></span><span>                        </span><span class="hs-identifier">res</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">readIOPort</span><span> </span><span class="hs-identifier">signal</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">catch</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">cancel</span><span>
</span><span id="line-685"></span><span>                        </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-string">&quot;:: signaled &quot;</span><span>
</span><span id="line-686"></span><span>                        </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">res</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-687"></span><span>                          </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-identifier">err</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">FFI.throwWinErr</span><span> </span><span class="hs-identifier">fname</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">maybe</span><span> </span><span class="hs-number">0</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">err</span><span class="hs-special">)</span><span>
</span><span id="line-688"></span><span>                          </span><span class="hs-identifier">_</span><span>            </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-689"></span><span>
</span><span id="line-690"></span><span>        </span><span class="hs-comment">-- Sometimes we shouldn't bother with the I/O manager as the call has</span><span>
</span><span id="line-691"></span><span>        </span><span class="hs-comment">-- failed or is done.</span><span>
</span><span id="line-692"></span><span>        </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">startCBResult</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-693"></span><span>          </span><span class="hs-identifier">CbPending</span><span>    </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">runner</span><span>
</span><span id="line-694"></span><span>          </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">rdata</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-695"></span><span>            </span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">I.exchangePtr</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-identifier">nullReq</span><span>
</span><span id="line-696"></span><span>            </span><span class="hs-keyword">if</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">cdData</span><span class="hs-special">)</span><span>
</span><span id="line-697"></span><span>              </span><span class="hs-keyword">then</span><span>
</span><span id="line-698"></span><span>                </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">reqs2</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">removeRequest</span><span>
</span><span id="line-699"></span><span>                   </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;-1.. &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs2</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; requests queued.&quot;</span><span>
</span><span id="line-700"></span><span>                   </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: done &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; - &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">rdata</span><span>
</span><span id="line-701"></span><span>                   </span><span class="hs-identifier">bytes</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">isJust</span><span> </span><span class="hs-identifier">rdata</span><span>
</span><span id="line-702"></span><span>                               </span><span class="hs-keyword">then</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">rdata</span><span>
</span><span id="line-703"></span><span>                               </span><span class="hs-comment">-- Make sure it's safe to free the OVERLAPPED buffer</span><span>
</span><span id="line-704"></span><span>                               </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">FFI.getOverlappedResult</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-705"></span><span>                   </span><span class="hs-identifier">cdDataCheck2</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CompletionData</span><span class="hs-special">)</span><span>
</span><span id="line-706"></span><span>                   </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: exit *ptr_lpol: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">cdDataCheck2</span><span>
</span><span id="line-707"></span><span>                   </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: done bytes: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">bytes</span><span>
</span><span id="line-708"></span><span>                   </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">bytes</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-709"></span><span>                     </span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">res</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-number">0</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-710"></span><span>                     </span><span class="hs-identifier">Nothing</span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">err</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIOStatus</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-711"></span><span>                                    </span><span class="hs-identifier">numBytes</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIONumBytes</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-712"></span><span>                                    </span><span class="hs-comment">-- TODO: Remap between STATUS_ and ERROR_ instead</span><span>
</span><span id="line-713"></span><span>                                    </span><span class="hs-comment">-- of re-interpret here. But for now, don't care.</span><span>
</span><span id="line-714"></span><span>                                    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">err</span><span>
</span><span id="line-715"></span><span>                                    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: done callback: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; - &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">numBytes</span><span>
</span><span id="line-716"></span><span>                                    </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">numBytes</span><span class="hs-special">)</span><span>
</span><span id="line-717"></span><span>              </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">readIOPort</span><span> </span><span class="hs-identifier">signal</span><span>
</span><span id="line-718"></span><span>          </span><span class="hs-identifier">CbError</span><span> </span><span class="hs-identifier">err</span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-719"></span><span>            </span><span class="hs-identifier">reqs3</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">removeRequest</span><span>
</span><span id="line-720"></span><span>            </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;-1.. &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs3</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; requests queued.&quot;</span><span>
</span><span id="line-721"></span><span>            </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">err</span><span>
</span><span id="line-722"></span><span>            </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-identifier">err'</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-723"></span><span>          </span><span class="hs-identifier">_</span><span>            </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-724"></span><span>            </span><span class="hs-identifier">error</span><span> </span><span class="hs-string">&quot;unexpected case in `startCBResult'&quot;</span><span>
</span><span id="line-725"></span><span>      </span><span class="hs-keyword">where</span><span> </span><span class="hs-identifier">dbgMsg</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">s</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; (&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot;:&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">offset</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot;)&quot;</span><span>
</span><span id="line-726"></span><span>            </span><span class="hs-comment">-- Wait for .25ms (threaded) and 1ms (non-threaded)</span><span>
</span><span id="line-727"></span><span>            </span><span class="hs-comment">-- Yields in the threaded case allowing other work.</span><span>
</span><span id="line-728"></span><span>            </span><span class="hs-comment">-- Blocks all haskell execution in the non-threaded case.</span><span>
</span><span id="line-729"></span><span>            </span><span class="hs-comment">-- We might want to reconsider the non-threaded handling</span><span>
</span><span id="line-730"></span><span>            </span><span class="hs-comment">-- at some point.</span><span>
</span><span id="line-731"></span><span>            </span><span class="hs-identifier">doShortWait</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-732"></span><span>            </span><span class="hs-identifier">doShortWait</span><span>
</span><span id="line-733"></span><span>                </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-734"></span><span>                    </span><span class="hs-comment">-- Uses an inline definition of threadDelay to prevent an import</span><span>
</span><span id="line-735"></span><span>                    </span><span class="hs-comment">-- cycle.</span><span>
</span><span id="line-736"></span><span>                    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">usecs</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">250</span><span> </span><span class="hs-comment">-- 0.25ms</span><span>
</span><span id="line-737"></span><span>                    </span><span class="hs-identifier">m</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newEmptyIOPort</span><span>
</span><span id="line-738"></span><span>                    </span><span class="hs-identifier">reg</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">registerTimeout</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">usecs</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-739"></span><span>                                </span><span class="hs-identifier">writeIOPort</span><span> </span><span class="hs-identifier">m</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span> </span><span class="hs-operator">&gt;&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-740"></span><span>                    </span><span class="hs-identifier">readIOPort</span><span> </span><span class="hs-identifier">m</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">onException</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">unregisterTimeout</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">reg</span><span>
</span><span id="line-741"></span><span>                </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">sleepBlock</span><span> </span><span class="hs-number">1</span><span> </span><span class="hs-comment">-- 1 ms</span><span>
</span><span id="line-742"></span><span>            </span><span class="hs-identifier">waitForCompletion</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">FFI.OVERLAPPED</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">CbResult</span><span> </span><span class="hs-identifier">Int</span><span class="hs-special">)</span><span>
</span><span id="line-743"></span><span>            </span><span class="hs-identifier">waitForCompletion</span><span> </span><span class="hs-identifier">fhndl</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-744"></span><span>              </span><span class="hs-comment">-- Wait for the request to finish as it was running before and</span><span>
</span><span id="line-745"></span><span>              </span><span class="hs-comment">-- The I/O manager won't enqueue it due to our optimizations to</span><span>
</span><span id="line-746"></span><span>              </span><span class="hs-comment">-- prevent context switches in such cases.</span><span>
</span><span id="line-747"></span><span>              </span><span class="hs-comment">-- In the non-threaded case we must use a non-waiting query here</span><span>
</span><span id="line-748"></span><span>              </span><span class="hs-comment">-- otherwise the RTS will lock up until we get a result back.</span><span>
</span><span id="line-749"></span><span>              </span><span class="hs-comment">-- In the threaded case it can be beneficial to spin on the haskell</span><span>
</span><span id="line-750"></span><span>              </span><span class="hs-comment">-- side versus</span><span>
</span><span id="line-751"></span><span>              </span><span class="hs-comment">-- See also Note [Why use non-waiting getOverlappedResult requests.]</span><span>
</span><span id="line-752"></span><span>              </span><span class="hs-identifier">res</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.getOverlappedResult</span><span> </span><span class="hs-identifier">fhndl</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-753"></span><span>              </span><span class="hs-identifier">status</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIOStatus</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-754"></span><span>              </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">res</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-755"></span><span>                </span><span class="hs-identifier">Nothing</span><span> </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">status</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-glyph">-</span><span class="hs-number">1073741807</span><span>
</span><span id="line-756"></span><span class="hs-pragma">{-# LINE 756 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-756"></span><span>                        </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-757"></span><span>                              </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">completeSynchronousRequest</span><span>
</span><span id="line-758"></span><span>                              </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-759"></span><span>                        </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-760"></span><span>                  </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getLastError</span><span>
</span><span id="line-761"></span><span>                     </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">done</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">errorIsCompleted</span><span> </span><span class="hs-identifier">lasterr</span><span>
</span><span id="line-762"></span><span>                     </span><span class="hs-comment">-- debugIO $ &quot;:: loop - &quot; ++ show lasterr ++ &quot; :&quot; ++ show done</span><span>
</span><span id="line-763"></span><span>                     </span><span class="hs-comment">-- We will complete quite soon, in the threaded RTS we</span><span>
</span><span id="line-764"></span><span>                     </span><span class="hs-comment">-- probably don't really want to wait for it while we could</span><span>
</span><span id="line-765"></span><span>                     </span><span class="hs-comment">-- have done something else.  In particular this is because</span><span>
</span><span id="line-766"></span><span>                     </span><span class="hs-comment">-- of sockets which make take slightly longer.</span><span>
</span><span id="line-767"></span><span>                     </span><span class="hs-comment">-- There's a trade-off.  Using the timer would allow it do</span><span>
</span><span id="line-768"></span><span>                     </span><span class="hs-comment">-- to continue running other Haskell threads, but also</span><span>
</span><span id="line-769"></span><span>                     </span><span class="hs-comment">-- means it may take longer to complete the wait.</span><span>
</span><span id="line-770"></span><span>                     </span><span class="hs-identifier">unless</span><span> </span><span class="hs-identifier">done</span><span> </span><span class="hs-identifier">doShortWait</span><span>
</span><span id="line-771"></span><span>                     </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">done</span><span>
</span><span id="line-772"></span><span>                        </span><span class="hs-keyword">then</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span>
</span><span id="line-773"></span><span>                                  </span><span class="hs-identifier">completeSynchronousRequest</span><span>
</span><span id="line-774"></span><span>                                </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-775"></span><span>                        </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">waitForCompletion</span><span> </span><span class="hs-identifier">fhndl</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-776"></span><span>                </span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-777"></span><span>                   </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">completeSynchronousRequest</span><span>
</span><span id="line-778"></span><span>                   </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">CbDone</span><span> </span><span class="hs-identifier">res</span><span>
</span><span id="line-779"></span><span>            </span><span class="hs-identifier">unless</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Bool</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-780"></span><span>            </span><span class="hs-identifier">unless</span><span> </span><span class="hs-identifier">p</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">p</span><span> </span><span class="hs-keyword">then</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-781"></span><span>
</span><span id="line-782"></span><span class="hs-comment">-- Safe version of function</span><span>
</span><span id="line-783"></span><span class="hs-identifier">withOverlapped</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">String</span><span>
</span><span id="line-784"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">HANDLE</span><span>
</span><span id="line-785"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Word64</span><span> </span><span class="hs-comment">-- ^ Value to use for the @OVERLAPPED@</span><span>
</span><span id="line-786"></span><span>                         </span><span class="hs-comment">--   structure's Offset/OffsetHigh members.</span><span>
</span><span id="line-787"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">StartIOCallback</span><span> </span><span class="hs-identifier">Int</span><span>
</span><span id="line-788"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">CompletionCallback</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-789"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-790"></span><span class="hs-identifier">withOverlapped</span><span> </span><span class="hs-identifier">fname</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">offset</span><span> </span><span class="hs-identifier">startCB</span><span> </span><span class="hs-identifier">completionCB</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-791"></span><span>  </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getSystemManager</span><span>
</span><span id="line-792"></span><span>  </span><span class="hs-identifier">withOverlappedEx</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-identifier">fname</span><span> </span><span class="hs-identifier">h</span><span> </span><span class="hs-identifier">offset</span><span> </span><span class="hs-identifier">startCB</span><span> </span><span class="hs-identifier">completionCB</span><span>
</span><span id="line-793"></span><span>
</span><span id="line-794"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-795"></span><span class="hs-comment">-- Helper to check if an error code implies an operation has completed.</span><span>
</span><span id="line-796"></span><span>
</span><span id="line-797"></span><span class="hs-identifier">errorIsCompleted</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">ErrCode</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Bool</span><span>
</span><span id="line-798"></span><span class="hs-identifier">errorIsCompleted</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-799"></span><span>       </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">38</span><span>
</span><span id="line-800"></span><span class="hs-pragma">{-# LINE 800 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-800"></span><span>    </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-801"></span><span class="hs-pragma">{-# LINE 801 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-801"></span><span>    </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">109</span><span>
</span><span id="line-802"></span><span class="hs-pragma">{-# LINE 802 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-802"></span><span>    </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">259</span><span>
</span><span id="line-803"></span><span class="hs-pragma">{-# LINE 803 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-803"></span><span>    </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">lasterr</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-number">995</span><span>
</span><span id="line-804"></span><span class="hs-pragma">{-# LINE 804 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-804"></span><span>
</span><span id="line-805"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-806"></span><span class="hs-comment">-- I/O Utilities</span><span>
</span><span id="line-807"></span><span>
</span><span id="line-808"></span><span class="hs-comment">-- | Process an IOResult and throw an exception back to the user if the action</span><span>
</span><span id="line-809"></span><span class="hs-comment">-- has failed, or return the result.</span><span>
</span><span id="line-810"></span><span class="hs-identifier">withException</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">String</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">a</span><span>
</span><span id="line-811"></span><span class="hs-identifier">withException</span><span> </span><span class="hs-identifier">name</span><span> </span><span class="hs-identifier">fn</span><span>
</span><span id="line-812"></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">res</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fn</span><span>
</span><span id="line-813"></span><span>      </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">res</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-814"></span><span>       </span><span class="hs-identifier">IOSuccess</span><span> </span><span class="hs-identifier">a</span><span>         </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">a</span><span>
</span><span id="line-815"></span><span>       </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">err</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">FFI.throwWinErr</span><span> </span><span class="hs-identifier">name</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">err</span><span>
</span><span id="line-816"></span><span>       </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-identifier">Nothing</span><span>    </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">FFI.throwWinErr</span><span> </span><span class="hs-identifier">name</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-817"></span><span>
</span><span id="line-818"></span><span class="hs-comment">-- | Signal that the I/O action was successful.</span><span>
</span><span id="line-819"></span><span class="hs-identifier">ioSuccess</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-820"></span><span class="hs-identifier">ioSuccess</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">IOSuccess</span><span>
</span><span id="line-821"></span><span>
</span><span id="line-822"></span><span class="hs-comment">-- | Signal that the I/O action has failed with the given reason.</span><span>
</span><span id="line-823"></span><span class="hs-identifier">ioFailed</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Integral</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=&gt;</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span>
</span><span id="line-824"></span><span class="hs-identifier">ioFailed</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">Just</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">fromIntegral</span><span>
</span><span id="line-825"></span><span>
</span><span id="line-826"></span><span class="hs-comment">-- | Signal that the I/O action has failed with the given reason.</span><span>
</span><span id="line-827"></span><span class="hs-comment">-- Polymorphic in successful result type.</span><span>
</span><span id="line-828"></span><span class="hs-identifier">ioFailedAny</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Integral</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">=&gt;</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">IOResult</span><span> </span><span class="hs-identifier">b</span><span class="hs-special">)</span><span>
</span><span id="line-829"></span><span class="hs-identifier">ioFailedAny</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">IOFailed</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">Just</span><span> </span><span class="hs-operator">.</span><span> </span><span class="hs-identifier">fromIntegral</span><span>
</span><span id="line-830"></span><span>
</span><span id="line-831"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-832"></span><span class="hs-comment">-- Timeouts</span><span>
</span><span id="line-833"></span><span>
</span><span id="line-834"></span><span class="hs-comment">-- | Convert uS(Int) to nS(Word64/Q.Prio) capping at maxBound</span><span>
</span><span id="line-835"></span><span class="hs-identifier">expirationTime</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Clock</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Int</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Q.Prio</span><span>
</span><span id="line-836"></span><span class="hs-identifier">expirationTime</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">us</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-837"></span><span>    </span><span class="hs-identifier">now</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getTime</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-comment">-- Double</span><span>
</span><span id="line-838"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">now_ns</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">ceiling</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">now</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Word64</span><span>
</span><span id="line-839"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">expTime</span><span>
</span><span id="line-840"></span><span>          </span><span class="hs-comment">-- Currently we treat overflows by clamping to maxBound. If humanity</span><span>
</span><span id="line-841"></span><span>          </span><span class="hs-comment">-- still exists in 2500 CE we will ned to be a bit more careful here.</span><span>
</span><span id="line-842"></span><span>          </span><span class="hs-comment">-- See #15158.</span><span>
</span><span id="line-843"></span><span>          </span><span class="hs-glyph">|</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">maxBound</span><span> </span><span class="hs-glyph">-</span><span> </span><span class="hs-identifier">now_ns</span><span class="hs-special">)</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">quot</span><span class="hs-special">`</span><span> </span><span class="hs-number">1000</span><span> </span><span class="hs-operator">&lt;</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">us</span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">maxBound</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Q.Prio</span><span>
</span><span id="line-844"></span><span>          </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span>                                          </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">now_ns</span><span> </span><span class="hs-operator">+</span><span> </span><span class="hs-identifier">ns</span><span>
</span><span id="line-845"></span><span>          </span><span class="hs-keyword">where</span><span> </span><span class="hs-identifier">ns</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">1000</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">us</span><span>
</span><span id="line-846"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">expTime</span><span>
</span><span id="line-847"></span><span>
</span><span id="line-848"></span><span class="hs-comment">-- | Register an action to be performed in the given number of seconds.  The</span><span>
</span><span id="line-849"></span><span class="hs-comment">-- returned 'TimeoutKey' can be used to later un-register or update the timeout.</span><span>
</span><span id="line-850"></span><span class="hs-comment">-- The timeout is automatically unregistered when it fires.</span><span>
</span><span id="line-851"></span><span class="hs-comment">--</span><span>
</span><span id="line-852"></span><span class="hs-comment">-- The 'TimeoutCallback' will not be called more than once.</span><span>
</span><span id="line-853"></span><span class="hs-pragma">{-# NOINLINE</span><span> </span><span class="hs-pragma">registerTimeout</span><span> </span><span class="hs-pragma">#-}</span><span>
</span><span id="line-854"></span><span class="hs-identifier">registerTimeout</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Int</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutCallback</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">TimeoutKey</span><span>
</span><span id="line-855"></span><span class="hs-identifier">registerTimeout</span><span> </span><span class="hs-identifier">mgr</span><span class="hs-glyph">@</span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-identifier">uSrelTime</span><span> </span><span class="hs-identifier">cb</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-856"></span><span>    </span><span class="hs-identifier">key</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newUnique</span><span> </span><span class="hs-identifier">mgrUniqueSource</span><span>
</span><span id="line-857"></span><span>    </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">uSrelTime</span><span> </span><span class="hs-operator">&lt;=</span><span> </span><span class="hs-number">0</span><span> </span><span class="hs-keyword">then</span><span> </span><span class="hs-identifier">cb</span><span>
</span><span id="line-858"></span><span>    </span><span class="hs-keyword">else</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-859"></span><span>      </span><span class="hs-glyph">!</span><span class="hs-identifier">expTime</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">expirationTime</span><span> </span><span class="hs-identifier">mgrClock</span><span> </span><span class="hs-identifier">uSrelTime</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Q.Prio</span><span>
</span><span id="line-860"></span><span>      </span><span class="hs-identifier">editTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Q.unsafeInsertNew</span><span> </span><span class="hs-identifier">key</span><span> </span><span class="hs-identifier">expTime</span><span> </span><span class="hs-identifier">cb</span><span class="hs-special">)</span><span>
</span><span id="line-861"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">TK</span><span> </span><span class="hs-identifier">key</span><span>
</span><span id="line-862"></span><span>
</span><span id="line-863"></span><span class="hs-comment">-- | Update an active timeout to fire in the given number of seconds (from the</span><span>
</span><span id="line-864"></span><span class="hs-comment">-- time 'updateTimeout' is called), instead of when it was going to fire.</span><span>
</span><span id="line-865"></span><span class="hs-comment">-- This has no effect if the timeout has already fired.</span><span>
</span><span id="line-866"></span><span class="hs-identifier">updateTimeout</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutKey</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-867"></span><span class="hs-identifier">updateTimeout</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">TK</span><span> </span><span class="hs-identifier">key</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">relTime</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-868"></span><span>    </span><span class="hs-identifier">now</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getTime</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mgrClock</span><span> </span><span class="hs-identifier">mgr</span><span class="hs-special">)</span><span>
</span><span id="line-869"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">expTime</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">secondsToNanoSeconds</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">now</span><span> </span><span class="hs-operator">+</span><span> </span><span class="hs-identifier">relTime</span><span>
</span><span id="line-870"></span><span>    </span><span class="hs-comment">-- Note: editTimeouts unconditionally wakes the IO Manager</span><span>
</span><span id="line-871"></span><span>    </span><span class="hs-comment">--       but that is not required if the new time is after</span><span>
</span><span id="line-872"></span><span>    </span><span class="hs-comment">--       the current time.</span><span>
</span><span id="line-873"></span><span>    </span><span class="hs-identifier">editTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Q.adjust</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">const</span><span> </span><span class="hs-identifier">expTime</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">key</span><span class="hs-special">)</span><span>
</span><span id="line-874"></span><span>
</span><span id="line-875"></span><span class="hs-comment">-- | Unregister an active timeout.  This is a harmless no-op if the timeout is</span><span>
</span><span id="line-876"></span><span class="hs-comment">-- already unregistered or has already fired.</span><span>
</span><span id="line-877"></span><span class="hs-comment">--</span><span>
</span><span id="line-878"></span><span class="hs-comment">-- Warning: the timeout callback may fire even after</span><span>
</span><span id="line-879"></span><span class="hs-comment">-- 'unregisterTimeout' completes.</span><span>
</span><span id="line-880"></span><span class="hs-identifier">unregisterTimeout</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutKey</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-881"></span><span class="hs-identifier">unregisterTimeout</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">TK</span><span> </span><span class="hs-identifier">key</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-882"></span><span>    </span><span class="hs-identifier">editTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Q.delete</span><span> </span><span class="hs-identifier">key</span><span class="hs-special">)</span><span>
</span><span id="line-883"></span><span>
</span><span id="line-884"></span><span class="hs-comment">-- | Modify an existing timeout.  This isn't thread safe and so if the time to</span><span>
</span><span id="line-885"></span><span class="hs-comment">-- elapse the timer was close it may fire anyway.</span><span>
</span><span id="line-886"></span><span class="hs-identifier">editTimeouts</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutEdit</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-887"></span><span class="hs-identifier">editTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">g</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-888"></span><span>  </span><span class="hs-identifier">atomicModifyIORef'</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mgrTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">tq</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">g</span><span> </span><span class="hs-identifier">tq</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-889"></span><span>  </span><span class="hs-identifier">interruptSystemManager</span><span>
</span><span id="line-890"></span><span>
</span><span id="line-891"></span><span class="hs-comment">------------------------------------------------------------------------</span><span>
</span><span id="line-892"></span><span class="hs-comment">-- I/O manager loop</span><span>
</span><span id="line-893"></span><span>
</span><span id="line-894"></span><span class="hs-comment">-- | Call all expired timeouts, and return how much time until the next</span><span>
</span><span id="line-895"></span><span class="hs-comment">-- | expiration.</span><span>
</span><span id="line-896"></span><span class="hs-identifier">runExpiredTimeouts</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">)</span><span>
</span><span id="line-897"></span><span class="hs-identifier">runExpiredTimeouts</span><span> </span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-898"></span><span>    </span><span class="hs-identifier">now</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getTime</span><span> </span><span class="hs-identifier">mgrClock</span><span>
</span><span id="line-899"></span><span>    </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">delay</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">atomicModifyIORef'</span><span> </span><span class="hs-identifier">mgrTimeouts</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">mkTimeout</span><span> </span><span class="hs-identifier">now</span><span class="hs-special">)</span><span>
</span><span id="line-900"></span><span>    </span><span class="hs-comment">-- Execute timeout callbacks.</span><span>
</span><span id="line-901"></span><span>    </span><span class="hs-identifier">mapM_</span><span> </span><span class="hs-identifier">Q.value</span><span> </span><span class="hs-identifier">expired</span><span>
</span><span id="line-902"></span><span>    </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span> </span><span class="hs-operator">&amp;&amp;</span><span> </span><span class="hs-identifier">not</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">null</span><span> </span><span class="hs-identifier">expired</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-903"></span><span>      </span><span class="hs-identifier">completeSynchronousRequest</span><span>
</span><span id="line-904"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;expired calls: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">length</span><span> </span><span class="hs-identifier">expired</span><span class="hs-special">)</span><span>
</span><span id="line-905"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-906"></span><span>      </span><span class="hs-keyword">where</span><span>
</span><span id="line-907"></span><span>        </span><span class="hs-identifier">mkTimeout</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutQueue</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-908"></span><span>                     </span><span class="hs-special">(</span><span class="hs-identifier">TimeoutQueue</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="hs-identifier">Q.Elem</span><span> </span><span class="hs-identifier">TimeoutCallback</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-909"></span><span>        </span><span class="hs-identifier">mkTimeout</span><span> </span><span class="hs-identifier">now</span><span> </span><span class="hs-identifier">tq</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-910"></span><span>            </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">tq'</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">sec</span><span class="hs-special">)</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">mkTimeout'</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">secondsToNanoSeconds</span><span> </span><span class="hs-identifier">now</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">tq</span><span>
</span><span id="line-911"></span><span>            </span><span class="hs-keyword">in</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">tq'</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">fmap</span><span> </span><span class="hs-identifier">nanoSecondsToSeconds</span><span> </span><span class="hs-identifier">sec</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-912"></span><span>        </span><span class="hs-identifier">mkTimeout'</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Q.Prio</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">TimeoutQueue</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-913"></span><span>                     </span><span class="hs-special">(</span><span class="hs-identifier">TimeoutQueue</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-special">[</span><span class="hs-identifier">Q.Elem</span><span> </span><span class="hs-identifier">TimeoutCallback</span><span class="hs-special">]</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Q.Prio</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-914"></span><span>        </span><span class="hs-identifier">mkTimeout'</span><span> </span><span class="hs-identifier">now</span><span> </span><span class="hs-identifier">tq</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-915"></span><span>           </span><span class="hs-comment">-- Remove timeouts with expiration &lt;= now.</span><span>
</span><span id="line-916"></span><span>           </span><span class="hs-keyword">let</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">tq'</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">Q.atMost</span><span> </span><span class="hs-identifier">now</span><span> </span><span class="hs-identifier">tq</span><span> </span><span class="hs-keyword">in</span><span>
</span><span id="line-917"></span><span>           </span><span class="hs-comment">-- See how soon the next timeout expires.</span><span>
</span><span id="line-918"></span><span>           </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">Q.prio</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">fmap</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">Q.findMin</span><span> </span><span class="hs-identifier">tq'</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-919"></span><span>            </span><span class="hs-identifier">Nothing</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-920"></span><span>                </span><span class="hs-special">(</span><span class="hs-identifier">tq'</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Nothing</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-921"></span><span>            </span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">t</span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-922"></span><span>                </span><span class="hs-comment">-- This value will always be positive since the call</span><span>
</span><span id="line-923"></span><span>                </span><span class="hs-comment">-- to 'atMost' above removed any timeouts &lt;= 'now'</span><span>
</span><span id="line-924"></span><span>                </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">t'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">t</span><span> </span><span class="hs-glyph">-</span><span> </span><span class="hs-identifier">now</span><span>
</span><span id="line-925"></span><span>                </span><span class="hs-keyword">in</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">tq'</span><span class="hs-special">,</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">expired</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">t'</span><span class="hs-special">)</span><span class="hs-special">)</span><span>
</span><span id="line-926"></span><span>
</span><span id="line-927"></span><span class="hs-comment">-- | Return the delay argument to pass to GetQueuedCompletionStatus.</span><span>
</span><span id="line-928"></span><span class="hs-comment">--   Return value is in ms</span><span>
</span><span id="line-929"></span><span class="hs-identifier">fromTimeout</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Word32</span><span>
</span><span id="line-930"></span><span class="hs-identifier">fromTimeout</span><span> </span><span class="hs-identifier">Nothing</span><span>                 </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">120000</span><span>
</span><span id="line-931"></span><span class="hs-identifier">fromTimeout</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">sec</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">sec</span><span> </span><span class="hs-operator">&gt;</span><span> </span><span class="hs-number">120</span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">120000</span><span>
</span><span id="line-932"></span><span>                       </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">sec</span><span> </span><span class="hs-operator">&gt;</span><span> </span><span class="hs-number">0</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">ceiling</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">sec</span><span> </span><span class="hs-operator">*</span><span> </span><span class="hs-number">1000</span><span class="hs-special">)</span><span>
</span><span id="line-933"></span><span>                       </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">otherwise</span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-934"></span><span>
</span><span id="line-935"></span><span class="hs-comment">-- | Perform one full evaluation step of the I/O manager's service loop.</span><span>
</span><span id="line-936"></span><span class="hs-comment">-- This means process timeouts and completed completions and calculate the time</span><span>
</span><span id="line-937"></span><span class="hs-comment">-- for the next timeout.</span><span>
</span><span id="line-938"></span><span class="hs-comment">--</span><span>
</span><span id="line-939"></span><span class="hs-comment">-- The I/O manager is then notified of how long it should block again based on</span><span>
</span><span id="line-940"></span><span class="hs-comment">-- the queued I/O requests and timers.  If the I/O manager was given a command</span><span>
</span><span id="line-941"></span><span class="hs-comment">-- to block, shutdown or suspend than that request is honored at the end of the</span><span>
</span><span id="line-942"></span><span class="hs-comment">-- loop.</span><span>
</span><span id="line-943"></span><span class="hs-comment">--</span><span>
</span><span id="line-944"></span><span class="hs-comment">-- This function can be safely executed multiple times in parallel and is only</span><span>
</span><span id="line-945"></span><span class="hs-comment">-- used by the threaded manager.</span><span>
</span><span id="line-946"></span><span class="hs-identifier">step</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Bool</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Bool</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">)</span><span>
</span><span id="line-947"></span><span class="hs-identifier">step</span><span> </span><span class="hs-identifier">maxDelay</span><span> </span><span class="hs-identifier">mgr</span><span class="hs-glyph">@</span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-948"></span><span>    </span><span class="hs-comment">-- Determine how long to wait the next time we block in an alertable state.</span><span>
</span><span id="line-949"></span><span>    </span><span class="hs-identifier">delay</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">runExpiredTimeouts</span><span> </span><span class="hs-identifier">mgr</span><span>
</span><span id="line-950"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">timer</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">maxDelay</span><span> </span><span class="hs-operator">&amp;&amp;</span><span> </span><span class="hs-identifier">delay</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">Nothing</span><span>
</span><span id="line-951"></span><span>                    </span><span class="hs-keyword">then</span><span> </span><span class="hs-number">4294967295</span><span>
</span><span id="line-952"></span><span class="hs-pragma">{-# LINE 952 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-952"></span><span>                    </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">fromTimeout</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-953"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;next timer: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">timer</span><span> </span><span class="hs-comment">-- todo: print as hex</span><span>
</span><span id="line-954"></span><span>    </span><span class="hs-keyword">if</span><span> </span><span class="hs-identifier">isJust</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-955"></span><span>        </span><span class="hs-keyword">then</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;I/O manager waiting: delay=&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-956"></span><span>        </span><span class="hs-keyword">else</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;I/O manager pausing: maxDelay=&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">maxDelay</span><span>
</span><span id="line-957"></span><span>
</span><span id="line-958"></span><span>    </span><span class="hs-comment">-- Inform the threadpool that a thread is now</span><span>
</span><span id="line-959"></span><span>    </span><span class="hs-comment">-- entering a kernel mode wait and thus is ready for new work.</span><span>
</span><span id="line-960"></span><span>    </span><span class="hs-identifier">notifyWaiting</span><span> </span><span class="hs-identifier">mgrThreadPool</span><span>
</span><span id="line-961"></span><span>
</span><span id="line-962"></span><span>    </span><span class="hs-comment">-- To quote Matt Godbolts:</span><span>
</span><span id="line-963"></span><span>    </span><span class="hs-comment">-- There are some unusual edge cases you need to deal with. The</span><span>
</span><span id="line-964"></span><span>    </span><span class="hs-comment">-- GetQueuedCompletionStatus function blocks a thread until there's</span><span>
</span><span id="line-965"></span><span>    </span><span class="hs-comment">-- work for it to do. Based on the return value, the number of bytes</span><span>
</span><span id="line-966"></span><span>    </span><span class="hs-comment">-- and the overlapped structure, there&#8217;s a lot of possible &quot;reasons&quot;</span><span>
</span><span id="line-967"></span><span>    </span><span class="hs-comment">-- for the function to have returned. Deciphering all the possible</span><span>
</span><span id="line-968"></span><span>    </span><span class="hs-comment">-- cases:</span><span>
</span><span id="line-969"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-970"></span><span>    </span><span class="hs-comment">-- ------------------------------------------------------------------------</span><span>
</span><span id="line-971"></span><span>    </span><span class="hs-comment">-- Ret value | OVERLAPPED | # of bytes | Description</span><span>
</span><span id="line-972"></span><span>    </span><span class="hs-comment">-- ------------------------------------------------------------------------</span><span>
</span><span id="line-973"></span><span>    </span><span class="hs-comment">-- zero      | NULL       | n/a        | Call to GetQueuedCompletionStatus</span><span>
</span><span id="line-974"></span><span>    </span><span class="hs-comment">--   failed, and no data was dequeued from the IO port. This usually</span><span>
</span><span id="line-975"></span><span>    </span><span class="hs-comment">--   indicates an error in the parameters to GetQueuedCompletionStatus.</span><span>
</span><span id="line-976"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-977"></span><span>    </span><span class="hs-comment">-- zero      | non-NULL   | n/a        | Call to GetQueuedCompletionStatus</span><span>
</span><span id="line-978"></span><span>    </span><span class="hs-comment">--   failed, but data was read or written. The thread must deal with the</span><span>
</span><span id="line-979"></span><span>    </span><span class="hs-comment">--   data (possibly freeing any associated buffers), but there is an error</span><span>
</span><span id="line-980"></span><span>    </span><span class="hs-comment">--   condition on the underlying HANDLE. Usually seen when the other end of</span><span>
</span><span id="line-981"></span><span>    </span><span class="hs-comment">--   a network connection has been forcibly closed but there's still data in</span><span>
</span><span id="line-982"></span><span>    </span><span class="hs-comment">--   the send or receive queue.</span><span>
</span><span id="line-983"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-984"></span><span>    </span><span class="hs-comment">-- non-zero  | NULL       | n/a        | This condition doesn't happen due</span><span>
</span><span id="line-985"></span><span>    </span><span class="hs-comment">--   to IO requests, but is useful to use in combination with</span><span>
</span><span id="line-986"></span><span>    </span><span class="hs-comment">--   PostQueuedCompletionStatus as a way of indicating to threads that they</span><span>
</span><span id="line-987"></span><span>    </span><span class="hs-comment">--   should terminate.</span><span>
</span><span id="line-988"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-989"></span><span>    </span><span class="hs-comment">-- non-zero  | non-NULL   | zero       | End of file for a file HANDLE, or</span><span>
</span><span id="line-990"></span><span>    </span><span class="hs-comment">--   the connection has been gracefully closed (for network connections).</span><span>
</span><span id="line-991"></span><span>    </span><span class="hs-comment">--   The OVERLAPPED buffer has still been used; and must be deallocated if</span><span>
</span><span id="line-992"></span><span>    </span><span class="hs-comment">--   necessary.</span><span>
</span><span id="line-993"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-994"></span><span>    </span><span class="hs-comment">-- non-zero  | non-NULL   | non-zero   | &quot;num bytes&quot; of data have been</span><span>
</span><span id="line-995"></span><span>    </span><span class="hs-comment">--    transferred into the block pointed by the OVERLAPPED structure. The</span><span>
</span><span id="line-996"></span><span>    </span><span class="hs-comment">--    direction of the transfer is dependant on the call made to the IO</span><span>
</span><span id="line-997"></span><span>    </span><span class="hs-comment">--    port, it's up to the user to remember if it was a read or a write</span><span>
</span><span id="line-998"></span><span>    </span><span class="hs-comment">--    (usually by stashing extra data in the OVERLAPPED structure). The</span><span>
</span><span id="line-999"></span><span>    </span><span class="hs-comment">--    thread must deallocate the structure as necessary.</span><span>
</span><span id="line-1000"></span><span>    </span><span class="hs-comment">--</span><span>
</span><span id="line-1001"></span><span>    </span><span class="hs-comment">-- The getQueuedCompletionStatusEx call will remove entries queued by the OS</span><span>
</span><span id="line-1002"></span><span>    </span><span class="hs-comment">-- and returns the finished ones in mgrOverlappedEntries and the number of</span><span>
</span><span id="line-1003"></span><span>    </span><span class="hs-comment">-- entries removed.</span><span>
</span><span id="line-1004"></span><span>    </span><span class="hs-identifier">n</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.getQueuedCompletionStatusEx</span><span> </span><span class="hs-identifier">mgrIOCP</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span> </span><span class="hs-identifier">timer</span><span>
</span><span id="line-1005"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;WinIORunning&quot;</span><span>
</span><span id="line-1006"></span><span>    </span><span class="hs-comment">-- If threaded this call informs the threadpool manager that a thread is</span><span>
</span><span id="line-1007"></span><span>    </span><span class="hs-comment">-- busy.  If all threads are busy and we have not reached the maximum amount</span><span>
</span><span id="line-1008"></span><span>    </span><span class="hs-comment">-- of allowed threads then the threadpool manager will spawn a new thread to</span><span>
</span><span id="line-1009"></span><span>    </span><span class="hs-comment">-- allow us to scale under load.</span><span>
</span><span id="line-1010"></span><span>    </span><span class="hs-identifier">notifyRunning</span><span> </span><span class="hs-identifier">mgrThreadPool</span><span>
</span><span id="line-1011"></span><span>    </span><span class="hs-identifier">processCompletion</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-1012"></span><span>
</span><span id="line-1013"></span><span class="hs-comment">-- | Process the results at the end of an evaluation loop.  This function will</span><span>
</span><span id="line-1014"></span><span class="hs-comment">-- read all the completions, unblock up all the Haskell threads, clean up the book</span><span>
</span><span id="line-1015"></span><span class="hs-comment">-- keeping of the I/O manager.</span><span>
</span><span id="line-1016"></span><span class="hs-comment">-- It returns whether there is outstanding work (request or timer) to be</span><span>
</span><span id="line-1017"></span><span class="hs-comment">-- done and how long it expects to have to wait till it can take action again.</span><span>
</span><span id="line-1018"></span><span class="hs-comment">--</span><span>
</span><span id="line-1019"></span><span class="hs-comment">-- Note that this method can do less work than there are entries in the</span><span>
</span><span id="line-1020"></span><span class="hs-comment">-- completion table.  This is because some completion entries may have been</span><span>
</span><span id="line-1021"></span><span class="hs-comment">-- created due to calls to interruptIOManager which will enqueue a faux</span><span>
</span><span id="line-1022"></span><span class="hs-comment">-- completion.</span><span>
</span><span id="line-1023"></span><span class="hs-comment">--</span><span>
</span><span id="line-1024"></span><span class="hs-comment">-- NOTE: In Threaded mode things get a bit complicated the operation may have</span><span>
</span><span id="line-1025"></span><span class="hs-comment">-- been completed even before we even got around to put the request in the</span><span>
</span><span id="line-1026"></span><span class="hs-comment">-- waiting callback table.  These events are handled by having a separate queue</span><span>
</span><span id="line-1027"></span><span class="hs-comment">-- for orphaned callback instances that the calling thread is supposed to check</span><span>
</span><span id="line-1028"></span><span class="hs-comment">-- before adding something to the work queue.</span><span>
</span><span id="line-1029"></span><span class="hs-comment">--</span><span>
</span><span id="line-1030"></span><span class="hs-comment">-- Thread safety: This function atomically replaces outstanding events with</span><span>
</span><span id="line-1031"></span><span class="hs-comment">-- a pointer to nullReq. This means it's safe (but potentially wastefull) to</span><span>
</span><span id="line-1032"></span><span class="hs-comment">-- have two concurrent or parallel invocations on the same array.</span><span>
</span><span id="line-1033"></span><span class="hs-identifier">processCompletion</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Int</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Bool</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">)</span><span>
</span><span id="line-1034"></span><span class="hs-identifier">processCompletion</span><span> </span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-identifier">delay</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1035"></span><span>    </span><span class="hs-comment">-- If some completions are done, we need to process them and call their</span><span>
</span><span id="line-1036"></span><span>    </span><span class="hs-comment">-- callbacks.  We then remove the callbacks from the bookkeeping and resize</span><span>
</span><span id="line-1037"></span><span>    </span><span class="hs-comment">-- the array if required.</span><span>
</span><span id="line-1038"></span><span>    </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">n</span><span> </span><span class="hs-operator">&gt;</span><span> </span><span class="hs-number">0</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1039"></span><span>      </span><span class="hs-identifier">forM_</span><span> </span><span class="hs-special">[</span><span class="hs-number">0</span><span class="hs-glyph">..</span><span class="hs-special">(</span><span class="hs-identifier">n</span><span class="hs-glyph">-</span><span class="hs-number">1</span><span class="hs-special">)</span><span class="hs-special">]</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">idx</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1040"></span><span>        </span><span class="hs-identifier">oe</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">A.unsafeRead</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span> </span><span class="hs-identifier">idx</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">OVERLAPPED_ENTRY</span><span>
</span><span id="line-1041"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">lpol</span><span>     </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">lpOverlapped</span><span> </span><span class="hs-identifier">oe</span><span>
</span><span id="line-1042"></span><span>        </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">lpol</span><span> </span><span class="hs-operator">/=</span><span> </span><span class="hs-identifier">nullPtr</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1043"></span><span>          </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">hs_lpol</span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">castPtr</span><span> </span><span class="hs-identifier">lpol</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">FFI.HASKELL_OVERLAPPED</span><span>
</span><span id="line-1044"></span><span>          </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">castPtr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">hs_lpol</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">plusPtr</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">cdOffset</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CompletionData</span><span class="hs-special">)</span><span>
</span><span id="line-1045"></span><span>          </span><span class="hs-identifier">cdDataCheck</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">ptr_lpol</span><span>
</span><span id="line-1046"></span><span>          </span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">I.exchangePtr</span><span> </span><span class="hs-identifier">ptr_lpol</span><span> </span><span class="hs-identifier">nullReq</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Ptr</span><span> </span><span class="hs-identifier">CompletionData</span><span class="hs-special">)</span><span>
</span><span id="line-1047"></span><span>          </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot; $ checking &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">lpol</span><span>
</span><span id="line-1048"></span><span>                    </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; -en ptr_lpol: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">ptr_lpol</span><span>
</span><span id="line-1049"></span><span>                    </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; offset: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">cdOffset</span><span>
</span><span id="line-1050"></span><span>                    </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; cdData: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">cdDataCheck</span><span>
</span><span id="line-1051"></span><span>                    </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; at idx &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">idx</span><span>
</span><span id="line-1052"></span><span>          </span><span class="hs-identifier">ptrd</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">ptr_lpol</span><span>
</span><span id="line-1053"></span><span>          </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: nullReq &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">nullReq</span><span>
</span><span id="line-1054"></span><span>          </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: oldDataPtr &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">oldDataPtr</span><span>
</span><span id="line-1055"></span><span>          </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;:: oldDataPtr (ptr)&quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">ptrd</span><span>
</span><span id="line-1056"></span><span>          </span><span class="hs-comment">-- A nullPtr indicates that we received a request which we shouldn't</span><span>
</span><span id="line-1057"></span><span>          </span><span class="hs-comment">-- have. Essentially the field is 0 initialized and a nullPtr means</span><span>
</span><span id="line-1058"></span><span>          </span><span class="hs-comment">-- it wasn't given a payload.</span><span>
</span><span id="line-1059"></span><span>          </span><span class="hs-comment">-- A nullReq means that something else already handled the request,</span><span>
</span><span id="line-1060"></span><span>          </span><span class="hs-comment">-- this can happen if for instance the request was cancelled.</span><span>
</span><span id="line-1061"></span><span>          </span><span class="hs-comment">-- The former is an error while the latter is OK.  For now we treat</span><span>
</span><span id="line-1062"></span><span>          </span><span class="hs-comment">-- them both as the same, but external tools such as API monitor are</span><span>
</span><span id="line-1063"></span><span>          </span><span class="hs-comment">-- used to distinguish between the two when doing API tracing.</span><span>
</span><span id="line-1064"></span><span>          </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-operator">/=</span><span> </span><span class="hs-identifier">nullPtr</span><span> </span><span class="hs-operator">&amp;&amp;</span><span> </span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-operator">/=</span><span> </span><span class="hs-identifier">castPtr</span><span> </span><span class="hs-identifier">nullReq</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span>
</span><span id="line-1065"></span><span>            </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;exchanged: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">oldDataPtr</span><span>
</span><span id="line-1066"></span><span>               </span><span class="hs-identifier">payload</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">oldDataPtr</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">CompletionData</span><span>
</span><span id="line-1067"></span><span>               </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">cb</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">cdCallback</span><span> </span><span class="hs-identifier">payload</span><span>
</span><span id="line-1068"></span><span>               </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">removeRequest</span><span>
</span><span id="line-1069"></span><span>               </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;-1.. &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; requests queued.&quot;</span><span>
</span><span id="line-1070"></span><span>               </span><span class="hs-identifier">status</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">FFI.overlappedIOStatus</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">lpOverlapped</span><span> </span><span class="hs-identifier">oe</span><span class="hs-special">)</span><span>
</span><span id="line-1071"></span><span>               </span><span class="hs-comment">-- TODO: Remap between STATUS_ and ERROR_ instead</span><span>
</span><span id="line-1072"></span><span>               </span><span class="hs-comment">-- of re-interpret here. But for now, don't care.</span><span>
</span><span id="line-1073"></span><span>               </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">status'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-identifier">status</span><span>
</span><span id="line-1074"></span><span>               </span><span class="hs-comment">-- We no longer explicitly free the memory, this is because we</span><span>
</span><span id="line-1075"></span><span>               </span><span class="hs-comment">-- now require the callback to free the memory since the</span><span>
</span><span id="line-1076"></span><span>               </span><span class="hs-comment">-- callback allocated it.  This allows us to simplify memory</span><span>
</span><span id="line-1077"></span><span>               </span><span class="hs-comment">-- management and reduce bugs.  See Note [Memory Management].</span><span>
</span><span id="line-1078"></span><span>               </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">bytes</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">dwNumberOfBytesTransferred</span><span> </span><span class="hs-identifier">oe</span><span>
</span><span id="line-1079"></span><span>               </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;?: status &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">status'</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; - &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">bytes</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; bytes return.&quot;</span><span>
</span><span id="line-1080"></span><span>               </span><span class="hs-identifier">cb</span><span> </span><span class="hs-identifier">status'</span><span> </span><span class="hs-identifier">bytes</span><span>
</span><span id="line-1081"></span><span>
</span><span id="line-1082"></span><span>      </span><span class="hs-comment">-- clear the array so we don't erroneously interpret the output, in</span><span>
</span><span id="line-1083"></span><span>      </span><span class="hs-comment">-- certain circumstances like lockFileEx the code could return 1 entry</span><span>
</span><span id="line-1084"></span><span>      </span><span class="hs-comment">-- removed but the file data not been filled in.</span><span>
</span><span id="line-1085"></span><span>      </span><span class="hs-comment">-- TODO: Maybe not needed..</span><span>
</span><span id="line-1086"></span><span>      </span><span class="hs-identifier">A.clear</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span>
</span><span id="line-1087"></span><span>
</span><span id="line-1088"></span><span>      </span><span class="hs-comment">-- Check to see if we received the maximum amount of entries we could</span><span>
</span><span id="line-1089"></span><span>      </span><span class="hs-comment">-- this likely indicates a high number of I/O requests have been queued.</span><span>
</span><span id="line-1090"></span><span>      </span><span class="hs-comment">-- In which case we should process more at a time.</span><span>
</span><span id="line-1091"></span><span>      </span><span class="hs-identifier">cap</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">A.capacity</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span>
</span><span id="line-1092"></span><span>      </span><span class="hs-identifier">when</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">cap</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">n</span><span class="hs-special">)</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">A.ensureCapacity</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span> </span><span class="hs-special">(</span><span class="hs-number">2</span><span class="hs-operator">*</span><span class="hs-identifier">cap</span><span class="hs-special">)</span><span>
</span><span id="line-1093"></span><span>
</span><span id="line-1094"></span><span>    </span><span class="hs-comment">-- Keep running if we still have some work queued or</span><span>
</span><span id="line-1095"></span><span>    </span><span class="hs-comment">-- if we have a pending delay.</span><span>
</span><span id="line-1096"></span><span>    </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">outstandingRequests</span><span>
</span><span id="line-1097"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;outstanding requests: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">reqs</span><span>
</span><span id="line-1098"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">more</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">reqs</span><span> </span><span class="hs-operator">&gt;</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-1099"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;has more: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">more</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-string">&quot; - removed: &quot;</span><span> </span><span class="hs-operator">++</span><span>  </span><span class="hs-identifier">show</span><span> </span><span class="hs-identifier">n</span><span>
</span><span id="line-1100"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">more</span><span> </span><span class="hs-operator">||</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">isJust</span><span> </span><span class="hs-identifier">delay</span><span> </span><span class="hs-operator">&amp;&amp;</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span class="hs-special">)</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">delay</span><span class="hs-special">)</span><span>
</span><span id="line-1101"></span><span>
</span><span id="line-1102"></span><span class="hs-comment">-- | Entry point for the non-threaded I/O manager to be able to process</span><span>
</span><span id="line-1103"></span><span class="hs-comment">-- completed completions.  It is mostly a wrapper around processCompletion</span><span>
</span><span id="line-1104"></span><span class="hs-comment">-- and invoked by the C thread via the scheduler.</span><span>
</span><span id="line-1105"></span><span class="hs-identifier">processRemoteCompletion</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1106"></span><span class="hs-identifier">processRemoteCompletion</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1107"></span><span>
</span><span id="line-1108"></span><span class="hs-pragma">{-# LINE 1111 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1111"></span><span>  </span><span class="hs-identifier">alloca</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">ptr_n</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1112"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;processRemoteCompletion :: start ()&quot;</span><span>
</span><span id="line-1113"></span><span>    </span><span class="hs-comment">-- First figure out how much work we have to do.</span><span>
</span><span id="line-1114"></span><span>    </span><span class="hs-identifier">entries</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getOverlappedEntries</span><span> </span><span class="hs-identifier">ptr_n</span><span>
</span><span id="line-1115"></span><span>    </span><span class="hs-identifier">n</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">fmap</span><span class="hs-special">`</span><span> </span><span class="hs-identifier">peek</span><span> </span><span class="hs-identifier">ptr_n</span><span>
</span><span id="line-1116"></span><span>    </span><span class="hs-comment">-- This call will unmarshal data from the C buffer but pointers inside of</span><span>
</span><span id="line-1117"></span><span>    </span><span class="hs-comment">-- this have not been read yet.</span><span>
</span><span id="line-1118"></span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">peekArray</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-identifier">entries</span><span>
</span><span id="line-1119"></span><span>    </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getSystemManager</span><span>
</span><span id="line-1120"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">arr</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">mgrOverlappedEntries</span><span> </span><span class="hs-identifier">mngr</span><span>
</span><span id="line-1121"></span><span>    </span><span class="hs-identifier">A.unsafeCopyFromBuffer</span><span> </span><span class="hs-identifier">arr</span><span> </span><span class="hs-identifier">entries</span><span> </span><span class="hs-identifier">n</span><span>
</span><span id="line-1122"></span><span>
</span><span id="line-1123"></span><span>    </span><span class="hs-comment">-- Process timeouts</span><span>
</span><span id="line-1124"></span><span>    </span><span class="hs-identifier">delay</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">runExpiredTimeouts</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span class="hs-special">)</span><span>
</span><span id="line-1125"></span><span>
</span><span id="line-1126"></span><span>    </span><span class="hs-comment">-- Process available completions</span><span>
</span><span id="line-1127"></span><span>    </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">processCompletion</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-identifier">n</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-1128"></span><span>
</span><span id="line-1129"></span><span>    </span><span class="hs-comment">-- Update and potentially wake up IO Manager</span><span>
</span><span id="line-1130"></span><span>    </span><span class="hs-comment">-- This call will unblock the non-threaded I/O manager.  After this it is no</span><span>
</span><span id="line-1131"></span><span>    </span><span class="hs-comment">-- longer safe to use `entries` nor `completed` as they can now be modified</span><span>
</span><span id="line-1132"></span><span>    </span><span class="hs-comment">-- by the C thread.</span><span>
</span><span id="line-1133"></span><span>    </span><span class="hs-identifier">registerAlertableWait</span><span> </span><span class="hs-identifier">delay</span><span>
</span><span id="line-1134"></span><span>
</span><span id="line-1135"></span><span>    </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;processRemoteCompletion :: done ()&quot;</span><span>
</span><span id="line-1136"></span><span>    </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1137"></span><span>
</span><span id="line-1138"></span><span class="hs-identifier">registerAlertableWait</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Maybe</span><span> </span><span class="hs-identifier">Seconds</span><span>  </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1139"></span><span class="hs-identifier">registerAlertableWait</span><span> </span><span class="hs-identifier">Nothing</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-1140"></span><span>  </span><span class="hs-identifier">c_registerAlertableWait</span><span> </span><span class="hs-identifier">False</span><span> </span><span class="hs-number">0</span><span>
</span><span id="line-1141"></span><span class="hs-identifier">registerAlertableWait</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Just</span><span> </span><span class="hs-identifier">delay</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-1142"></span><span>  </span><span class="hs-identifier">c_registerAlertableWait</span><span> </span><span class="hs-identifier">True</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">secondsToMilliSeconds</span><span> </span><span class="hs-identifier">delay</span><span class="hs-special">)</span><span>
</span><span id="line-1143"></span><span>
</span><span id="line-1144"></span><span class="hs-comment">-- | Event loop for the Threaded I/O manager.  The one for the non-threaded</span><span>
</span><span id="line-1145"></span><span class="hs-comment">-- I/O manager is in AsyncWinIO.c in the rts.</span><span>
</span><span id="line-1146"></span><span class="hs-identifier">io_mngr_loop</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1147"></span><span class="hs-identifier">io_mngr_loop</span><span> </span><span class="hs-identifier">_event</span><span> </span><span class="hs-identifier">_mgr</span><span>
</span><span id="line-1148"></span><span>  </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">not</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span>
</span><span id="line-1149"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>  </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;io_mngr_loop:no-op:called in non-threaded case&quot;</span><span>
</span><span id="line-1150"></span><span>        </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1151"></span><span class="hs-identifier">io_mngr_loop</span><span> </span><span class="hs-identifier">_event</span><span> </span><span class="hs-identifier">mgr</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">go</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-1152"></span><span>    </span><span class="hs-keyword">where</span><span>
</span><span id="line-1153"></span><span>      </span><span class="hs-identifier">go</span><span> </span><span class="hs-identifier">maxDelay</span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-1154"></span><span>          </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;io_mngr_loop:WinIORunning&quot;</span><span>
</span><span id="line-1155"></span><span>             </span><span class="hs-comment">-- Step will process IO events, or block if none are outstanding.</span><span>
</span><span id="line-1156"></span><span>             </span><span class="hs-special">(</span><span class="hs-identifier">more</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">delay</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">step</span><span> </span><span class="hs-identifier">maxDelay</span><span> </span><span class="hs-identifier">mgr</span><span>
</span><span id="line-1157"></span><span>             </span><span class="hs-keyword">let</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">use_max_delay</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">not</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">isJust</span><span> </span><span class="hs-identifier">delay</span><span> </span><span class="hs-operator">||</span><span> </span><span class="hs-identifier">more</span><span class="hs-special">)</span><span>
</span><span id="line-1158"></span><span>             </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;I/O manager stepping.&quot;</span><span>
</span><span id="line-1159"></span><span>             </span><span class="hs-identifier">event_id</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">c_readIOManagerEvent</span><span>
</span><span id="line-1160"></span><span>             </span><span class="hs-identifier">exit</span><span> </span><span class="hs-glyph">&lt;-</span><span>
</span><span id="line-1161"></span><span>               </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">event_id</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1162"></span><span>                 </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">event_id</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">io_MANAGER_WAKEUP</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-1163"></span><span>                 </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">event_id</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">io_MANAGER_DIE</span><span>    </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">True</span><span>
</span><span id="line-1164"></span><span>                 </span><span class="hs-number">0</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">False</span><span> </span><span class="hs-comment">-- spurious wakeup</span><span>
</span><span id="line-1165"></span><span>                 </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-string">&quot;handling console event: &quot;</span><span> </span><span class="hs-operator">++</span><span> </span><span class="hs-identifier">show</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">event_id</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">shiftR</span><span class="hs-special">`</span><span> </span><span class="hs-number">1</span><span class="hs-special">)</span><span>
</span><span id="line-1166"></span><span>                         </span><span class="hs-identifier">start_console_handler</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">event_id</span><span> </span><span class="hs-special">`</span><span class="hs-identifier">shiftR</span><span class="hs-special">`</span><span> </span><span class="hs-number">1</span><span class="hs-special">)</span><span>
</span><span id="line-1167"></span><span>                         </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">False</span><span>
</span><span id="line-1168"></span><span>
</span><span id="line-1169"></span><span>             </span><span class="hs-comment">-- If we have no more work to do, or something from the outside</span><span>
</span><span id="line-1170"></span><span>             </span><span class="hs-comment">-- told us to stop then we let the thread die and stop the I/O</span><span>
</span><span id="line-1171"></span><span>             </span><span class="hs-comment">-- manager.  It will be woken up again when there is more to do.</span><span>
</span><span id="line-1172"></span><span>             </span><span class="hs-keyword">case</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1173"></span><span>               </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">|</span><span> </span><span class="hs-identifier">exit</span><span>              </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;I/O manager shutting down.&quot;</span><span>
</span><span id="line-1174"></span><span>               </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">go</span><span> </span><span class="hs-identifier">use_max_delay</span><span>
</span><span id="line-1175"></span><span>
</span><span id="line-1176"></span><span>
</span><span id="line-1177"></span><span class="hs-identifier">io_MANAGER_WAKEUP</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">io_MANAGER_DIE</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Word32</span><span>
</span><span id="line-1178"></span><span class="hs-identifier">io_MANAGER_WAKEUP</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">4294967295</span><span>
</span><span id="line-1179"></span><span class="hs-pragma">{-# LINE 1179 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1179"></span><span class="hs-identifier">io_MANAGER_DIE</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-number">4294967294</span><span>
</span><span id="line-1180"></span><span class="hs-pragma">{-# LINE 1180 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1180"></span><span>
</span><span id="line-1181"></span><span class="hs-comment">-- | Wake up a single thread from the I/O Manager's worker queue.  This will</span><span>
</span><span id="line-1182"></span><span class="hs-comment">-- unblock a thread blocked in `processCompletion` and allows the I/O manager to</span><span>
</span><span id="line-1183"></span><span class="hs-comment">-- react accordingly to changes in timers or to process console signals.</span><span>
</span><span id="line-1184"></span><span class="hs-comment">-- No-op if the io-manager is already running.</span><span>
</span><span id="line-1185"></span><span class="hs-identifier">wakeupIOManager</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1186"></span><span class="hs-identifier">wakeupIOManager</span><span>
</span><span id="line-1187"></span><span>  </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span> </span><span class="hs-identifier">mngr</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">getSystemManager</span><span>
</span><span id="line-1188"></span><span>       </span><span class="hs-comment">-- We don't care about the event handle here, only that it exists.</span><span>
</span><span id="line-1189"></span><span>       </span><span class="hs-identifier">_event</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">c_getIOManagerEvent</span><span>
</span><span id="line-1190"></span><span>       </span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-string">&quot;waking up I/O manager.&quot;</span><span>
</span><span id="line-1191"></span><span>       </span><span class="hs-identifier">startIOManagerThread</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">io_mngr_loop</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">error</span><span> </span><span class="hs-string">&quot;IOManagerEvent used&quot;</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">mngr</span><span class="hs-special">)</span><span>
</span><span id="line-1192"></span><span>
</span><span id="line-1193"></span><span class="hs-comment">-- | Returns the signaling event for the IO Manager.</span><span>
</span><span id="line-1194"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;getIOManagerEvent&quot;</span><span> </span><span class="hs-comment">-- in the RTS (ThrIOManager.c)</span><span>
</span><span id="line-1195"></span><span>  </span><span class="hs-identifier">c_getIOManagerEvent</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">HANDLE</span><span>
</span><span id="line-1196"></span><span>
</span><span id="line-1197"></span><span class="hs-comment">-- | Reads one IO Manager event. For WINIO we distinguish:</span><span>
</span><span id="line-1198"></span><span class="hs-comment">-- * Shutdown events, sent from the RTS</span><span>
</span><span id="line-1199"></span><span class="hs-comment">-- * Console events, sent from the default console handler.</span><span>
</span><span id="line-1200"></span><span class="hs-comment">-- * Wakeup events, which are not used by WINIO and will be ignored</span><span>
</span><span id="line-1201"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;readIOManagerEvent&quot;</span><span> </span><span class="hs-comment">-- in the RTS (ThrIOManager.c)</span><span>
</span><span id="line-1202"></span><span>  </span><span class="hs-identifier">c_readIOManagerEvent</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">Word32</span><span>
</span><span id="line-1203"></span><span>
</span><span id="line-1204"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-keyword">ccall</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;rtsSupportsBoundThreads&quot;</span><span> </span><span class="hs-identifier">threadedIOMgr</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Bool</span><span>
</span><span id="line-1205"></span><span>
</span><span id="line-1206"></span><span class="hs-comment">-- | Sleep for n ms</span><span>
</span><span id="line-1207"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">WINDOWS_CCONV</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;Sleep&quot;</span><span> </span><span class="hs-identifier">sleepBlock</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Int</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1208"></span><span>
</span><span id="line-1209"></span><span class="hs-comment">-- ---------------------------------------------------------------------------</span><span>
</span><span id="line-1210"></span><span class="hs-comment">-- I/O manager event notifications</span><span>
</span><span id="line-1211"></span><span>
</span><span id="line-1212"></span><span>
</span><span id="line-1213"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">HandleData</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">HandleData</span><span> </span><span class="hs-special">{</span><span>
</span><span id="line-1214"></span><span>      </span><span class="hs-identifier">tokenKey</span><span>        </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">HandleKey</span><span>
</span><span id="line-1215"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">tokenEvents</span><span>     </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">EventLifetime</span><span>
</span><span id="line-1216"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">_handleCallback</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">EventCallback</span><span>
</span><span id="line-1217"></span><span>    </span><span class="hs-special">}</span><span>
</span><span id="line-1218"></span><span>
</span><span id="line-1219"></span><span class="hs-comment">-- | A file handle registration cookie.</span><span>
</span><span id="line-1220"></span><span class="hs-keyword">data</span><span> </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-special">{</span><span>
</span><span id="line-1221"></span><span>      </span><span class="hs-identifier">handleValue</span><span>  </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">HANDLE</span><span>
</span><span id="line-1222"></span><span>    </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">handleUnique</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-pragma">{-# UNPACK</span><span> </span><span class="hs-pragma">#-}</span><span> </span><span class="hs-glyph">!</span><span class="hs-identifier">Unique</span><span>
</span><span id="line-1223"></span><span>    </span><span class="hs-special">}</span><span> </span><span class="hs-keyword">deriving</span><span> </span><span class="hs-special">(</span><span> </span><span class="hs-identifier">Eq</span><span>   </span><span class="hs-comment">-- ^ @since 4.4.0.0</span><span>
</span><span id="line-1224"></span><span>               </span><span class="hs-special">,</span><span> </span><span class="hs-identifier">Show</span><span> </span><span class="hs-comment">-- ^ @since 4.4.0.0</span><span>
</span><span id="line-1225"></span><span>               </span><span class="hs-special">)</span><span>
</span><span id="line-1226"></span><span>
</span><span id="line-1227"></span><span class="hs-comment">-- | Callback invoked on I/O events.</span><span>
</span><span id="line-1228"></span><span class="hs-keyword">type</span><span> </span><span class="hs-identifier">EventCallback</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Event</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1229"></span><span>
</span><span id="line-1230"></span><span class="hs-identifier">registerHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">EventCallback</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">HANDLE</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Event</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">Lifetime</span><span>
</span><span id="line-1231"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-identifier">HandleKey</span><span>
</span><span id="line-1232"></span><span class="hs-identifier">registerHandle</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">cb</span><span> </span><span class="hs-identifier">hwnd</span><span> </span><span class="hs-identifier">evs</span><span> </span><span class="hs-identifier">lt</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1233"></span><span>  </span><span class="hs-identifier">u</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">newUnique</span><span> </span><span class="hs-identifier">mgrUniqueSource</span><span>
</span><span id="line-1234"></span><span>  </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">reg</span><span>   </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-identifier">hwnd</span><span> </span><span class="hs-identifier">u</span><span>
</span><span id="line-1235"></span><span>      </span><span class="hs-identifier">hwnd'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">ptrToIntPtr</span><span> </span><span class="hs-identifier">hwnd</span><span>
</span><span id="line-1236"></span><span>      </span><span class="hs-identifier">el</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">I.eventLifetime</span><span> </span><span class="hs-identifier">evs</span><span> </span><span class="hs-identifier">lt</span><span>
</span><span id="line-1237"></span><span>      </span><span class="hs-glyph">!</span><span class="hs-identifier">hwdd</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">HandleData</span><span> </span><span class="hs-identifier">reg</span><span> </span><span class="hs-identifier">el</span><span> </span><span class="hs-identifier">cb</span><span>
</span><span id="line-1238"></span><span>      </span><span class="hs-identifier">event</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-identifier">evs</span><span> </span><span class="hs-special">[</span><span class="hs-special">(</span><span class="hs-identifier">evs</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">hwdd</span><span class="hs-special">)</span><span class="hs-special">]</span><span>
</span><span id="line-1239"></span><span>  </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">withMVar</span><span> </span><span class="hs-identifier">mgrEvntHandlers</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">evts</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1240"></span><span>          </span><span class="hs-identifier">IT.insertWith</span><span> </span><span class="hs-identifier">mappend</span><span> </span><span class="hs-identifier">hwnd'</span><span> </span><span class="hs-identifier">event</span><span> </span><span class="hs-identifier">evts</span><span>
</span><span id="line-1241"></span><span>  </span><span class="hs-identifier">wakeupIOManager</span><span>
</span><span id="line-1242"></span><span>  </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">reg</span><span>
</span><span id="line-1243"></span><span>
</span><span id="line-1244"></span><span class="hs-identifier">unregisterHandle</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">Manager</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">HandleKey</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1245"></span><span class="hs-identifier">unregisterHandle</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">Manager</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">key</span><span class="hs-glyph">@</span><span class="hs-identifier">HandleKey</span><span class="hs-special">{</span><span class="hs-glyph">..</span><span class="hs-special">}</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1246"></span><span>  </span><span class="hs-identifier">withMVar</span><span> </span><span class="hs-identifier">mgrEvntHandlers</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-glyph">\</span><span class="hs-identifier">evts</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1247"></span><span>    </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">hwnd'</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">fromIntegral</span><span> </span><span class="hs-operator">$</span><span> </span><span class="hs-identifier">ptrToIntPtr</span><span> </span><span class="hs-identifier">handleValue</span><span>
</span><span id="line-1248"></span><span>    </span><span class="hs-identifier">val</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">IT.lookup</span><span> </span><span class="hs-identifier">hwnd'</span><span> </span><span class="hs-identifier">evts</span><span>
</span><span id="line-1249"></span><span>    </span><span class="hs-keyword">case</span><span> </span><span class="hs-identifier">val</span><span> </span><span class="hs-keyword">of</span><span>
</span><span id="line-1250"></span><span>      </span><span class="hs-identifier">Nothing</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1251"></span><span>      </span><span class="hs-identifier">Just</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">EventData</span><span> </span><span class="hs-identifier">evs</span><span> </span><span class="hs-identifier">lst</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-1252"></span><span>        </span><span class="hs-keyword">let</span><span> </span><span class="hs-identifier">cmp</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">a</span><span class="hs-special">)</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">_</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">b</span><span class="hs-special">)</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">tokenKey</span><span> </span><span class="hs-identifier">a</span><span> </span><span class="hs-operator">==</span><span> </span><span class="hs-identifier">tokenKey</span><span> </span><span class="hs-identifier">b</span><span>
</span><span id="line-1253"></span><span>            </span><span class="hs-identifier">key'</span><span>    </span><span class="hs-glyph">=</span><span> </span><span class="hs-special">(</span><span class="hs-identifier">undefined</span><span class="hs-special">,</span><span> </span><span class="hs-identifier">HandleData</span><span> </span><span class="hs-identifier">key</span><span> </span><span class="hs-identifier">undefined</span><span> </span><span class="hs-identifier">undefined</span><span class="hs-special">)</span><span>
</span><span id="line-1254"></span><span>            </span><span class="hs-identifier">updated</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">deleteBy</span><span> </span><span class="hs-identifier">cmp</span><span> </span><span class="hs-identifier">key'</span><span> </span><span class="hs-identifier">lst</span><span>
</span><span id="line-1255"></span><span>            </span><span class="hs-identifier">new_lst</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">EventData</span><span> </span><span class="hs-identifier">evs</span><span> </span><span class="hs-identifier">updated</span><span>
</span><span id="line-1256"></span><span>        </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="hs-identifier">IT.updateWith</span><span> </span><span class="hs-special">(</span><span class="hs-glyph">\</span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-identifier">new_lst</span><span class="hs-special">)</span><span> </span><span class="hs-identifier">hwnd'</span><span> </span><span class="hs-identifier">evts</span><span>
</span><span id="line-1257"></span><span>        </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1258"></span><span>
</span><span id="line-1259"></span><span class="hs-comment">-- ---------------------------------------------------------------------------</span><span>
</span><span id="line-1260"></span><span class="hs-comment">-- debugging</span><span>
</span><span id="line-1261"></span><span>
</span><span id="line-1262"></span><span>
</span><span id="line-1263"></span><span class="hs-pragma">{-# LINE 1266 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1266"></span><span>
</span><span id="line-1267"></span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-identifier">String</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="hs-identifier">IO</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1268"></span><span>
</span><span id="line-1269"></span><span class="hs-pragma">{-# LINE 1282 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1282"></span><span class="hs-identifier">debugIO</span><span> </span><span class="hs-identifier">_</span><span> </span><span class="hs-glyph">=</span><span> </span><span class="hs-identifier">return</span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-1283"></span><span>
</span><span id="line-1284"></span><span class="hs-pragma">{-# LINE 1284 &quot;libraries\\base\\GHC\\Event\\Windows.hsc&quot; #-}</span><span>
</span><span id="line-1284"></span><span>
</span><span id="line-1285"></span><span class="hs-comment">-- dbxIO :: String -&gt; IO ()</span><span>
</span><span id="line-1286"></span><span class="hs-comment">-- dbxIO s = do tid &lt;- myThreadId</span><span>
</span><span id="line-1287"></span><span class="hs-comment">--              let pref = if threadedIOMgr then &quot;\t&quot; else &quot;&quot;</span><span>
</span><span id="line-1288"></span><span class="hs-comment">--              _   &lt;- withCStringLen (pref ++ &quot;winio: &quot; ++ s ++ &quot; (&quot; ++</span><span>
</span><span id="line-1289"></span><span class="hs-comment">--                                    showThreadId tid ++ &quot;)\n&quot;) $</span><span>
</span><span id="line-1290"></span><span class="hs-comment">--                    \(p, len) -&gt; c_write 2 (castPtr p) (fromIntegral len)</span><span>
</span><span id="line-1291"></span><span class="hs-comment">--              return ()</span><span>
</span><span id="line-1292"></span></pre></body></html>